;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: classes.lisp,v 1.3 2002/10/09 23:03:41 kevin Exp $
+;;;; $Id: classes.lisp,v 1.4 2002/10/14 09:25:20 kevin Exp $
;;;;
;;;; This file, part of UMLisp, is
;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
(defludisp-ml-class disp-term #'find-uterm-lui)
(defludisp-ml-class disp-str #'find-ustr-sui)
+#+(or cmu sbcl)
+(dolist (c '(urank udef usat uso ucxt ustr ulo uterm usty urel ucoc uatx ucon uxw uxnw uxns lexterm labr lagr lcmp lmod lnom lprn lprp lspl ltrm ltyp lwd sdef sstr sstre1 sstre2 ))
+ (let ((cl #+cmu (pcl:find-class c)
+ #+sbcl (sb-pcl:find-class c)))
+ #+cmu (pcl:finalize-inheritance cl)
+ #+sbcl (sb-pcl:finalize-inheritance cl)))
+
+
+
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: composite.lisp,v 1.3 2002/10/09 23:03:41 kevin Exp $
+;;;; $Id: composite.lisp,v 1.4 2002/10/14 09:25:20 kevin Exp $
;;;;
;;;; This file, part of UMLisp, is
;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
(:fields (tui :string fmt-tui) (freq :fixnum) (sty :string))
(:documentation "Composite object of usty/freq"))
+(defun find-usty_freq-all ()
+ (let ((usty_freqs '()))
+ (dolist (tuple (mutex-sql-query "select distinct TUI from MRSTY"))
+ (let* ((tui (car tuple))
+ (freq (ensure-integer
+ (caar (mutex-sql-query
+ (format nil "select count(*) from MRSTY where TUI=~a" tui))))))
+ (push (make-instance 'usty_freq :usty (find-usty-tui tui) :freq freq) usty_freqs)))
+ (sort usty_freqs #'> :key #'freq)))
+
(defun usty_freq-tui (s)
(tui (usty s)))
(defun find-ucon2_freq-coc-tui-all (tui)
(find-ucon2_freq-tui-all tui #'find-ucon2-coc-tui))
+(dolist (c '(ucon_freq ustr_freq usty_freq usrl_freq))
+ (let ((cl #+cmu (pcl:find-class c)
+ #+sbcl (sb-pcl:find-class c)))
+ #+cmu (pcl:finalize-inheritance cl)
+ #+sbcl (sb-pcl:finalize-inheritance cl)))
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: parse-2002.lisp,v 1.3 2002/10/09 23:03:41 kevin Exp $
+;;;; $Id: parse-2002.lisp,v 1.4 2002/10/14 09:25:20 kevin Exp $
;;;;
;;;; This file, part of UMLisp, is
;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
(setq *parse-hash-init?* t))
(with-buffered-umls-file (line "MRCON")
(let ((cui (parse-ui (aref line 0)))
- (lui (parse-ui (nth 3 line)))
- (sui (parse-ui (nth 5 line)))
- (lrl (parse-integer (nth 7 line))))
+ (lui (parse-ui (aref line 3)))
+ (sui (parse-ui (aref line 5)))
+ (lrl (parse-integer (aref line 7))))
(unless (gethash cui pfstr-hash) ;; if haven't stored pfstr for cui
(if (and (string-equal (aref line 1) "ENG") ; LAT
(string-equal (aref line 2) "P") ; ts
(set-lrl-hash lui lrl lui-lrl-hash)
(set-lrl-hash (make-cuisui cui sui) lrl cuisui-lrl-hash)))
(with-buffered-umls-file (line "MRSO")
- (let ((sab (aref 3 line)))
+ (let ((sab (aref line 3)))
(unless (gethash sab sab-srl-hash) ;; if haven't stored
- (setf (gethash sab sab-srl-hash) (aref 6 line))))))
+ (setf (gethash sab sab-srl-hash) (aref line 6))))))
(defun init-hash-table (&optional (force-read nil))
(when (or force-read (not *parse-hash-init?*))
;;; sql-l - Big integer (64-bit)
;;; sql-f - Floating point
-(defconstant +col-datatypes+
+(defparameter +col-datatypes+
'(("AV" sql-f) ("BTS" sql-i) ("CLS" sql-i) ("COF" sql-i) ("CUI1" sql-u)
("CUI2" sql-u) ("CUI" sql-u) ("CXN" sql-s) ("FR" sql-i) ("LRL" sql-s)
("LUI" sql-u) ("MAX" sql-s) ("MIN" sql-s) ("RANK" sql-s) ("REF" sql-s)
("UI" sql-u) ("UI2" sql-u) ("UI3" sql-u))
"SQL data types for each non-string column")
-(defconstant +custom-tables+
+(defparameter +custom-tables+
nil
#+ignore
'(("MRCONSO" "SELECT m.CUI, m.LAT, m.TS, m.LUI, m.STT, m.SUI, m.STR, m.LRL, s.SAB, s.TTY, s.SCD, s.SRL FROM MRCON m, MRSO s WHERE m.CUI=s.CUI AND m.LUI=s.LUI AND m.SUI=s.SUI")
("MRCONFULL" "SELECT m.CUI, m.LAT, m.TS, m.LUI, m.STT, m.SUI, m.STR, m.LRL, s.SAB, s.TTY, s.SCD, s.SRL, t.TUI FROM MRCON m, MRSO s, MRSTY t WHERE m.CUI=s.CUI AND m.LUI=s.LUI AND m.SUI=s.SUI AND m.CUI=t.CUI AND s.CUI=t.CUI"))
"Custom tables to create")
-(defconstant +custom-cols+
+(defparameter +custom-cols+
'(("MRCON" "KPFSTR" "TEXT" 1024
(lambda (x) (pfstr-hash (parse-ui (nth 0 x)))))
("MRCON" "KCUISUI" "BIGINT" 0
(lambda (x) (format nil "~d" (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x)))))))
"Custom columns to create.(filename, col, sqltype, value-func).")
-(defconstant +index-cols+
+(defparameter +index-cols+
'(("CUI" "MRATX") ("CUI1" "MRCOC") ("CUI" "MRCON") ("LUI" "MRCON")
("LRL" "MRCON")
("SUI" "MRCON") ("CUI" "MRCXT") ("CUI" "MRDEF") ("CUI" "MRLO")
"Columns in files to index")
-(defconstant +custom-index-cols+
+(defparameter +custom-index-cols+
nil
#+ignore
'(("CUI" "MRCONFULL") ("SAB" "MRCONFULL") ("TUI" "MRCONFULL"))
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: sql-classes.lisp,v 1.3 2002/10/09 23:03:41 kevin Exp $
+;;;; $Id: sql-classes.lisp,v 1.4 2002/10/14 09:25:20 kevin Exp $
;;;;
;;;; This file, part of UMLisp, is
;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
;;; Lookup functions for uterms,ustr in ucons
(defun find-uterm-in-ucon (ucon lui)
- (find lui (s#term ucon) :key #'uterm-lui :test 'equal))
+ (find lui (s#term ucon) :key #'lui :test 'equal))
(defun find-ustr-in-uterm (uterm sui)
- (find sui (s#str uterm) :key #'ustr-sui :test 'equal))
+ (find sui (s#str uterm) :key #'sui :test 'equal))
(defun find-ustr-in-ucon (ucon sui)
(let ((found-ustr nil))
(defun find-ucon-rel-cui2 (cui2 &key (srl *current-srl*))
(mapcar
- #'(lambda (cui) (find-ucon-cui cui :key srl))
+ #'(lambda (cui) (find-ucon-cui cui :srl srl))
(remove-duplicates (mapcar #'cui1 (find-urel-cui2 cui2 :srl srl)))))
(defun find-ucoc-cui (cui &key (srl *current-srl*))
(defun find-ucon-coc-cui2 (cui2 &key (srl *current-srl*))
"List of ucon with co-occurance cui2"
(mapcar
- #'(lambda (cui) (find-ucon-cui cui :key srl))
+ #'(lambda (cui) (find-ucon-cui cui :srl srl))
(remove-duplicates (mapcar #'cui1 (find-ucoc-cui2 cui2 :srl srl)))))
(defun find-ulo-cui (cui &key (srl *current-srl*))
(push (find-usty-tui (nth 0 tuple)) ustys))
(nreverse ustys)))
-(defun find-usty_freq-all ()
- (let ((usty_freqs '()))
- (dolist (tuple (mutex-sql-query "select distinct TUI from MRSTY"))
- (let* ((tui (car tuple))
- (freq (ensure-integer
- (caar (mutex-sql-query
- (format nil "select count(*) from MRSTY where TUI=~a" tui))))))
- (push (make-instance 'usty_freq :usty (find-usty-tui tui) :freq freq) usty_freqs)))
- (sort usty_freqs #'> :key #'usty_freq-freq)))
-
-
-
(defun find-cui-max ()
(let ((cui (caar (mutex-sql-query "select max(CUI) from MRCON"))))
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: umlisp.asd,v 1.5 2002/10/13 16:47:29 kevin Exp $
+;;;; $Id: umlisp.asd,v 1.6 2002/10/14 09:25:20 kevin Exp $
;;;;
;;;; This file, part of UMLisp, is
;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
(in-package :asdf)
-#+(or allegro lispworks cmu)
-(defsystem umlisp
+#+(or allegro lispworks cmu sbcl)
+(defsystem :umlisp
+ :perform (load-op :after (op umlisp)
+ (pushnew :umlisp cl:*features*))
+
:components
((:file "package")
(:file "data-structures" :depends-on ("package"))
(:file "classes" :depends-on ("utils"))
(:file "sql-classes" :depends-on ("classes" "sql"))
(:file "composite" :depends-on ("sql-classes")))
- :depends-on (:kmrcl
- :clsql-mysql
- :clsql)
- )
+ :depends-on (:clsql-mysql
+ :clsql-postgresql
+ :clsql
+ :kmrcl))
+#+(or allegro lispworks cmu sbcl)
+(when (ignore-errors (find-class 'load-compiled-op))
+ (defmethod perform :after ((op load-compiled-op) (c (eql (find-system :umlisp))))
+ (pushnew :umlisp cl:*features*)))
projects / umlisp.git / commitdiff