From 5a80d916816131a1d56a60790cd1e4b5e9c88810 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Mon, 14 Oct 2002 09:25:25 +0000 Subject: [PATCH] r3016: *** empty log message *** --- classes.lisp | 11 ++++++++++- composite.lisp | 17 ++++++++++++++++- parse-2002.lisp | 22 +++++++++++----------- sql-classes.lisp | 22 +++++----------------- umlisp.asd | 21 ++++++++++++++------- 5 files changed, 56 insertions(+), 37 deletions(-) diff --git a/classes.lisp b/classes.lisp index 9bbd171..460878f 100644 --- a/classes.lisp +++ b/classes.lisp @@ -7,7 +7,7 @@ ;;;; 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. @@ -537,3 +537,12 @@ (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))) + + + diff --git a/composite.lisp b/composite.lisp index f363287..b49eec4 100644 --- a/composite.lisp +++ b/composite.lisp @@ -7,7 +7,7 @@ ;;;; 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. @@ -113,6 +113,16 @@ (: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))) @@ -192,3 +202,8 @@ (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))) diff --git a/parse-2002.lisp b/parse-2002.lisp index 07f9b9c..67a4e02 100644 --- a/parse-2002.lisp +++ b/parse-2002.lisp @@ -8,7 +8,7 @@ ;;;; 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. @@ -51,9 +51,9 @@ (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 @@ -63,9 +63,9 @@ (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?*)) @@ -132,7 +132,7 @@ ;;; 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) @@ -146,14 +146,14 @@ ("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 @@ -230,7 +230,7 @@ (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") @@ -259,7 +259,7 @@ "Columns in files to index") -(defconstant +custom-index-cols+ +(defparameter +custom-index-cols+ nil #+ignore '(("CUI" "MRCONFULL") ("SAB" "MRCONFULL") ("TUI" "MRCONFULL")) diff --git a/sql-classes.lisp b/sql-classes.lisp index 5aae593..2fc138b 100644 --- a/sql-classes.lisp +++ b/sql-classes.lisp @@ -7,7 +7,7 @@ ;;;; 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. @@ -69,10 +69,10 @@ ;;; 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)) @@ -255,7 +255,7 @@ (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*)) @@ -300,7 +300,7 @@ (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*)) @@ -561,18 +561,6 @@ (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")))) diff --git a/umlisp.asd b/umlisp.asd index 6830add..ee78240 100644 --- a/umlisp.asd +++ b/umlisp.asd @@ -7,7 +7,7 @@ ;;;; 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. @@ -18,8 +18,11 @@ (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")) @@ -31,8 +34,12 @@ (: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*))) -- 2.34.1