r2953: *** empty log message ***
authorKevin M. Rosenberg <kevin@rosenberg.net>
Wed, 9 Oct 2002 00:34:47 +0000 (00:34 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Wed, 9 Oct 2002 00:34:47 +0000 (00:34 +0000)
composite.lisp
data-structures.lisp
package.lisp
parse-2002.lisp
sql-classes.lisp
umlisp.asd

index d31c51321494f3cb4b9422e2085c3d1dfe660a80..611dfd18668101f5e869b7636d5f081e74c464d0 100644 (file)
@@ -1,4 +1,4 @@
-;;;; $Id: composite.lisp,v 1.1 2002/10/08 22:08:56 kevin Exp $
+;;;; $Id: composite.lisp,v 1.2 2002/10/09 00:34:47 kevin Exp $
 
 (in-package :umlisp)
 
@@ -6,10 +6,10 @@
 ;;; Semantic type constants
 
 (defun find-tui-word (words)
-  (gu:aif (car (find-usty-word words))
-       (tui gu::it)
+  (kmrcl:aif (car (find-usty-word words))
+       (tui kmrcl::it)
        nil))
-(gu:memoize 'find-tui-word)
+(kmrcl:memoize 'find-tui-word)
 
 (defun tui-disease-or-syndrome ()
   (find-tui-word "disease or syndrome"))
@@ -30,8 +30,8 @@
   (remove-duplicates 
    (filter
     #'(lambda (c) 
-       (gu:aif (funcall cui2-func c)
-            (let ((ucon2 (find-ucon-cui gu::it)))
+       (kmrcl:aif (funcall cui2-func c)
+            (let ((ucon2 (find-ucon-cui kmrcl::it)))
               (when (ucon-is-tui? ucon2 tui)
                 ucon2))
             nil))
 "Return sorted list of tuples with ucon and freq that have co-occuring concepts of semantic type tui" 
   (let ((ucon_freqs '())) 
     (dolist (ucoc (s#coc ucon)) 
-      (gu:aif (cui2 ucoc) 
-           (let ((ucon2 (find-ucon-cui gu::it))) 
+      (kmrcl:aif (cui2 ucoc) 
+           (let ((ucon2 (find-ucon-cui kmrcl::it))) 
              (when (ucon-is-tui? ucon2 tui)
               (push (make-instance 'ucon_freq :ucon ucon2 :freq (cof ucoc)) 
                     ucon_freqs)))))
   (let ((ucon_freqs (make-array (1+ (find-cui-max)) :initial-element nil)))
     (dolist (ucon (find-ucon-tui tui)) ;; for all disease-or-syn
       (dolist (ucon2 (funcall ucon2-tui-func ucon tui)) ;; for each related disease
-       (gu:aif (aref ucon_freqs (cui ucon2))
-            (setf (freq gu::it) (1+ (freq gu::it)))
+       (kmrcl:aif (aref ucon_freqs (cui ucon2))
+            (setf (freq kmrcl::it) (1+ (freq kmrcl::it)))
             (setf (aref ucon_freqs (cui ucon2)) 
               (make-instance 'ucon_freq :ucon ucon2 :freq 1)))))
     (let ((ucon_freq-list '()))
       (dotimes (i (find-cui-max))
        (declare (fixnum i))
-       (gu:awhen (aref ucon_freqs i)
-            (push gu::it ucon_freq-list)))
+       (kmrcl:awhen (aref ucon_freqs i)
+            (push kmrcl::it ucon_freq-list)))
       (sort ucon_freq-list #'> :key #'freq))))
 
 (defun find-ucon2_freq-rel-tui-all (tui)
index d13b7099116f41f1885235bc15c54951246c0268..a52c97de2968c7d4274d4570f1192b2445f0c86d 100644 (file)
@@ -1,19 +1,12 @@
-;;;; $Id: data-structures.lisp,v 1.1 2002/10/05 20:17:14 kevin Exp $
+;;;; $Id: data-structures.lisp,v 1.2 2002/10/09 00:34:47 kevin Exp $
 
 (in-package :umlisp)
 
 
 ;;; Paths for files
 
-(defvar *umls-path* 
-    (kboot:find-directory
-     '((nil (:absolute "data" "umls" "2002AC"))
-       (nil (:absolute "data" "umls" "2002AB"))
-       (nil (:absolute "data" "umls" "UMLS2001"))
-       #+mswindows ("F" (:absolute "umls" "2002ac"))
-       #+mswindows ("C" (:absolute "umls")) 
-       #+mswindows ("F" (:absolute "umls" "UMLS2001"))
-       ))
+(defvar *umls-path*
+  (make-pathname :directory '(:absolute "data" "umls" "2002AC"))
   "Path for base of UMLS data files")
 
 (defvar *meta-path* 
index 3bc20c1c0fb677865cf7f89198e0f710a85ab470..9cd24dbfb14f30cb5f0fb19a104eb7c497a35ece 100644 (file)
@@ -1,4 +1,4 @@
-;;;; $Id: package.lisp,v 1.1 2002/10/05 20:17:14 kevin Exp $
+;;;; $Id: package.lisp,v 1.2 2002/10/09 00:34:47 kevin Exp $
 ;;;; 
 ;;;; Package definition for UMLisp
 
@@ -6,6 +6,7 @@
 
 (defpackage umlisp
   (:nicknames :u)
+  (:uses :kmrcl)
   (:export 
    #:ucon
    #:uterm
index 3d6728ff119dd23cf34f07a3ca0904384f1c6af9..6f593ebeedef63241b5621ccd5e77a907a631f9a 100644 (file)
@@ -3,7 +3,7 @@
 ;;;   and inserting into SQL databases
 ;;;
 ;;; Copyright (c) 2001 Kevin M. Rosenberg, M.D.
-;;; $Id: parse-2002.lisp,v 1.1 2002/10/05 20:17:14 kevin Exp $
+;;; $Id: parse-2002.lisp,v 1.2 2002/10/09 00:34:47 kevin Exp $
 
 (in-package :umlisp)
 
@@ -91,7 +91,7 @@
     (gethash cuisui cuisui-lrl-hash))
   
   (defun sab-srl (sab)
-    (gu:aif (gethash sab sab-srl-hash) gu::it 0))
+    (kmrcl:aif (gethash sab sab-srl-hash) kmrcl::it 0))
 )) ;; closure
 
 (defun set-lrl-hash (key lrl hash)
       ("MRCOC" "KLRL" "INTEGER" 0
        (lambda (x) (format nil "~d" 
                    (max (cui-lrl (parse-ui (nth 0 x)))
-                        (gu:aif (cui-lrl (parse-ui (nth 1 x))) gu::it 0)))))
+                        (kmrcl:aif (cui-lrl (parse-ui (nth 1 x))) kmrcl::it 0)))))
       ("MRSAT" "KSRL" "INTEGER" 0
        (lambda (x) (format nil "~d" (sab-srl (nth 5 x)))))
       ("MRREL" "KSRL" "INTEGER" 0
index e193f8b89975e5e98daef92295e49b70c056e3e9..920ee8df4c4111fa9737b54ab5128903b3afab35 100644 (file)
@@ -1,4 +1,4 @@
-;;; $Id: sql-classes.lisp,v 1.1 2002/10/08 22:08:56 kevin Exp $
+;;; $Id: sql-classes.lisp,v 1.2 2002/10/09 00:34:47 kevin Exp $
  
 (in-package :umlisp)
 
@@ -79,9 +79,9 @@
        (if srl
            (string-append ls (format nil " and KCUILRL <= ~d limit 1" srl))
          (string-append ls " limit 1"))
-       (gu:awhen (car (mutex-sql-query ls))
-                 (make-instance 'ucon :cui cui :pfstr (car gu::it) 
-                                :lrl (ensure-integer (cadr gu::it)))))
+       (kmrcl:awhen (car (mutex-sql-query ls))
+                 (make-instance 'ucon :cui cui :pfstr (car kmrcl::it) 
+                                :lrl (ensure-integer (cadr kmrcl::it)))))
     nil))
 
 (defun find-ucon-lui (lui &key (srl *current-srl*))
                        (make-cuisui cui sui))))
        (when srl
            (string-append ls (format nil " and KCUILRL <= ~d" srl)))
-       (gu:aif (car (mutex-sql-query ls))
-            (make-instance 'ucon :cui (ensure-integer (nth 0 gu::it)) 
-                           :pfstr (nth 1 gu::it)
-                           :lrl (ensure-integer (nth 2 gu::it)))
+       (kmrcl:aif (car (mutex-sql-query ls))
+            (make-instance 'ucon :cui (ensure-integer (nth 0 kmrcl::it)) 
+                           :pfstr (nth 1 kmrcl::it)
+                           :lrl (ensure-integer (nth 2 kmrcl::it)))
             nil))
     nil))
 
   (let ((ls (format nil "select LAT,TS,KLUILRL from MRCON where KCUILUI=~d limit 1" (make-cuilui cui lui))))
     (when srl
        (string-append ls (format nil " and KLUILRL <= ~d" srl)))
-    (gu:aif (car (mutex-sql-query ls))
+    (kmrcl:aif (car (mutex-sql-query ls))
         (make-instance 'uterm :cui cui
                        :lui lui
-                       :lat (nth 0 gu::it)
-                      :ts (nth 1 gu::it)
-                      :lrl (ensure-integer (nth 2 gu::it)))
+                       :lat (nth 0 kmrcl::it)
+                      :ts (nth 1 kmrcl::it)
+                      :lrl (ensure-integer (nth 2 kmrcl::it)))
         nil)))
 
 (defun find-ustr-cuilui (cui lui &key (srl *current-srl*))
                    (make-cuisui cui sui))))
     (when srl
        (string-append ls (format nil " and LRL <= ~d" srl)))
-    (gu:aif (car (mutex-sql-query ls))
+    (kmrcl:aif (car (mutex-sql-query ls))
         (make-instance 'ustr :sui sui 
                        :cui cui
                        :cuisui (make-cuisui cui sui)
-                       :lui (ensure-integer (nth 0 gu::it))
-                       :stt (nth 1 gu::it)
-                       :str (nth 2 gu::it)
-                       :lrl (ensure-integer (nth 3 gu::it)))
+                       :lui (ensure-integer (nth 0 kmrcl::it))
+                       :stt (nth 1 kmrcl::it)
+                       :str (nth 2 kmrcl::it)
+                       :lrl (ensure-integer (nth 3 kmrcl::it)))
         nil)))
 
 (defun find-ustr-sui (sui &key (srl *current-srl*))
 (defun find-usty-tui (tui)
   "Find usty for tui"
   (setq tui (parse-tui tui)) 
-    (gu:aif (car (mutex-sql-query 
+    (kmrcl:aif (car (mutex-sql-query 
               (format nil "select STY from MRSTY where TUI=~d limit 1" tui)))
-        (make-instance 'usty :tui tui :sty (nth 0 gu::it))
+        (make-instance 'usty :tui tui :sty (nth 0 kmrcl::it))
         nil))
 
 (defun find-usty-sty (sty)
   "Find usty for a sty"
-  (gu:aif (car (mutex-sql-query 
+  (kmrcl:aif (car (mutex-sql-query 
                (format nil "select TUI from MRSTY where STY='~a' limit 1" sty)))
-         (make-instance 'usty :tui (ensure-integer (nth 0 gu::it)) :sty sty)
+         (make-instance 'usty :tui (ensure-integer (nth 0 kmrcl::it)) :sty sty)
          nil))
 
 (defun find-usty-all ()
@@ -732,9 +732,9 @@ eliminate duplicates."
     (decf score (- nlong nshort)) ;; reduce score for extra words
     (dotimes (iword nshort)
       (declare (fixnum iword))
-      (gu:aif (position (nth iword short-list) long-list :test #'string-equal)
+      (kmrcl:aif (position (nth iword short-list) long-list :test #'string-equal)
           (progn
-            (incf score (- 10 (abs (- gu::it iword))))
+            (incf score (- 10 (abs (- kmrcl::it iword))))
             (decf unmatched))))
     (decf score (* 2 unmatched))
     score))
@@ -743,15 +743,15 @@ eliminate duplicates."
 ;;; LEX SQL functions
 
 (defun find-lexterm-eui (eui)
-  (gu:awhen (car (mutex-sql-query
+  (kmrcl:awhen (car (mutex-sql-query
                  (format nil "select WRD from LRWD where EUI=~d" eui)))
-           (make-instance 'lexterm :eui eui :wrd (nth 0 gu:it))))
+           (make-instance 'lexterm :eui eui :wrd (nth 0 kmrcl:it))))
 
 (defun find-lexterm-word (wrd)
-  (gu:awhen (mutex-sql-query
+  (kmrcl:awhen (mutex-sql-query
             (format nil "select EUI from LRWD where WRD='~a'" wrd))
            (let ((terms '()))
-             (dolist (tuple gu:it)
+             (dolist (tuple kmrcl:it)
                (let ((eui (ensure-integer (nth 0 tuple))))
                  (push
                   (make-instance 'lexterm :eui eui :wrd (copy-seq wrd))
@@ -774,10 +774,10 @@ eliminate duplicates."
 ;; LEX SQL Read functions
 
 (defun find-labr-eui (eui)
-    (gu:awhen (mutex-sql-query 
+    (kmrcl:awhen (mutex-sql-query 
               (format nil "select BAS,ABR,EUI2,BAS2 from LRABR where EUI=~d" eui))
              (let ((results '()))
-               (dolist (tuple gu::it)
+               (dolist (tuple kmrcl::it)
                  (push
                   (make-instance 'labr :eui eui 
                                  :bas (nth 0 tuple) 
@@ -788,10 +788,10 @@ eliminate duplicates."
                (nreverse results))))
 
 (defun find-labr-bas (bas)
-  (gu:awhen (mutex-sql-query 
+  (kmrcl:awhen (mutex-sql-query 
               (format nil "select EUI,ABR,EUI2,BAS2 from LRABR where BAS='~a'" bas))
              (let ((results '()))
-               (dolist (tuple gu::it)
+               (dolist (tuple kmrcl::it)
                  (push
                   (make-instance 'labr :eui (ensure-integer (nth 0 tuple))
                                  :bas (copy-seq bas)
@@ -802,10 +802,10 @@ eliminate duplicates."
                (nreverse results))))
 
 (defun find-lagr-eui (eui)
-  (gu:awhen (mutex-sql-query 
+  (kmrcl:awhen (mutex-sql-query 
               (format nil "select STR,SCA,AGR,CIT,BAS from LRAGR where EUI=~d" eui))
              (let ((results '()))
-               (dolist (tuple gu::it)
+               (dolist (tuple kmrcl::it)
                  (push
                   (make-instance 'lagr 
                                  :eui eui
@@ -818,10 +818,10 @@ eliminate duplicates."
                (nreverse results))))
 
 (defun find-lcmp-eui (eui)
-  (gu:awhen (mutex-sql-query 
+  (kmrcl:awhen (mutex-sql-query 
               (format nil "select BAS,SCA,COM from LRCMP where EUI=~d" eui))
              (let ((results '()))
-               (dolist (tuple gu::it)
+               (dolist (tuple kmrcl::it)
                  (push
                   (make-instance 'lcmp
                                  :eui eui
@@ -832,10 +832,10 @@ eliminate duplicates."
                (nreverse results))))
 
 (defun find-lmod-eui (eui)
-  (gu:awhen (mutex-sql-query 
+  (kmrcl:awhen (mutex-sql-query 
               (format nil "select BAS,SCA,PSN_MOD,FEA from LRMOD where EUI=~d" eui))
              (let ((results '()))
-               (dolist (tuple gu::it)
+               (dolist (tuple kmrcl::it)
                  (push
                   (make-instance 'lmod
                                  :eui eui
@@ -847,10 +847,10 @@ eliminate duplicates."
                (nreverse results))))
 
 (defun find-lnom-eui (eui)
-  (gu:awhen (mutex-sql-query 
+  (kmrcl:awhen (mutex-sql-query 
               (format nil "select BAS,SCA,EUI2,BAS2,SCA2 from LRNOM where EUI=~d" eui))
              (let ((results '()))
-               (dolist (tuple gu::it)
+               (dolist (tuple kmrcl::it)
                  (push
                   (make-instance 'lnom
                                  :eui eui
@@ -863,10 +863,10 @@ eliminate duplicates."
                (nreverse results))))
 
 (defun find-lprn-eui (eui)
-  (gu:awhen (mutex-sql-query 
+  (kmrcl:awhen (mutex-sql-query 
               (format nil "select BAS,NUM,GND,CAS,POS,QNT,FEA from LRPRN where EUI=~d" eui))
              (let ((results '()))
-               (dolist (tuple gu::it)
+               (dolist (tuple kmrcl::it)
                  (push
                   (make-instance 'lprn
                                  :eui eui
@@ -881,10 +881,10 @@ eliminate duplicates."
                (nreverse results))))
 
 (defun find-lprp-eui (eui)
-  (gu:awhen (mutex-sql-query 
+  (kmrcl:awhen (mutex-sql-query 
               (format nil "select BAS,STR,SCA,FEA from LRPRP where EUI=~d" eui))
              (let ((results '()))
-               (dolist (tuple gu::it)
+               (dolist (tuple kmrcl::it)
                  (push
                   (make-instance 'lprp
                                  :eui eui
@@ -896,10 +896,10 @@ eliminate duplicates."
                (nreverse results))))
 
 (defun find-lspl-eui (eui)
-  (gu:awhen (mutex-sql-query 
+  (kmrcl:awhen (mutex-sql-query 
               (format nil "select SPV,BAS from LRSPL where EUI=~d" eui))
              (let ((results '()))
-               (dolist (tuple gu::it)
+               (dolist (tuple kmrcl::it)
                  (push
                   (make-instance 'lspl
                                  :eui eui
@@ -910,10 +910,10 @@ eliminate duplicates."
 
 
 (defun find-ltrm-eui (eui)
-  (gu:awhen (mutex-sql-query 
+  (kmrcl:awhen (mutex-sql-query 
               (format nil "select BAS,GEN from LRTRM where EUI=~d" eui))
              (let ((results '()))
-               (dolist (tuple gu::it)
+               (dolist (tuple kmrcl::it)
                  (push
                   (make-instance 'ltrm
                                  :eui eui
@@ -923,10 +923,10 @@ eliminate duplicates."
                (nreverse results))))
 
 (defun find-ltyp-eui (eui)
-  (gu:awhen (mutex-sql-query 
+  (kmrcl:awhen (mutex-sql-query 
               (format nil "select BAS,SCA,TYP from LRTYP where EUI=~d" eui))
              (let ((results '()))
-               (dolist (tuple gu::it)
+               (dolist (tuple kmrcl::it)
                  (push
                   (make-instance 'ltyp
                                  :eui eui
@@ -937,10 +937,10 @@ eliminate duplicates."
                (nreverse results))))
 
 (defun find-lwd-wrd (wrd)
-  (gu:awhen (mutex-sql-query 
+  (kmrcl:awhen (mutex-sql-query 
             (format nil "select EUI from LRWD where WRD='~a'" wrd))
              (let ((results '()))
-               (dolist (tuple gu::it)
+               (dolist (tuple kmrcl::it)
                  (push (ensure-integer (nth 0 tuple)) results))
                (make-instance 'lwd :wrd wrd
                               :euilist (nreverse results)))))
@@ -948,24 +948,24 @@ eliminate duplicates."
 ;;; Semantic Network SQL access functions
  
 (defun find-sdef-ui (ui)
-  (gu:awhen (car (mutex-sql-query 
+  (kmrcl:awhen (car (mutex-sql-query 
                  (format nil "select RT,STY_RL,STN_RTN,DEF,EX,UN,RH,ABR,RIN from SRDEF where UI=~d" ui)))
-           (make-instance 'sdef :rt (nth 0 gu::it)
+           (make-instance 'sdef :rt (nth 0 kmrcl::it)
                           :ui ui
-                          :styrl (nth 1 gu::it)
-                          :stnrtn (nth 2 gu::it)
-                          :def (nth 3 gu::it)
-                          :ex (nth 4 gu::it)
-                          :un (nth 5 gu::it)
-                          :rh (nth 6 gu::it)
-                          :abr (nth 7 gu::it)
-                          :rin (nth 8 gu::it))))
+                          :styrl (nth 1 kmrcl::it)
+                          :stnrtn (nth 2 kmrcl::it)
+                          :def (nth 3 kmrcl::it)
+                          :ex (nth 4 kmrcl::it)
+                          :un (nth 5 kmrcl::it)
+                          :rh (nth 6 kmrcl::it)
+                          :abr (nth 7 kmrcl::it)
+                          :rin (nth 8 kmrcl::it))))
 
 (defun find-sstre1-ui (ui)
-  (gu:awhen (mutex-sql-query 
+  (kmrcl:awhen (mutex-sql-query 
               (format nil "select UI2,UI3 from SRSTRE1 where UI=~d" ui))
              (let ((results '()))
-               (dolist (tuple gu::it)
+               (dolist (tuple kmrcl::it)
                  (push
                   (make-instance 'sstre1 :ui ui
                                  :ui2 (ensure-integer (nth 0 tuple))
@@ -974,10 +974,10 @@ eliminate duplicates."
                (nreverse results))))
 
 (defun find-sstre1-ui2 (ui2)
-  (gu:awhen (mutex-sql-query 
+  (kmrcl:awhen (mutex-sql-query 
               (format nil "select UI,UI3 from SRSTRE1 where UI2=~d" ui2))
              (let ((results '()))
-               (dolist (tuple gu::it)
+               (dolist (tuple kmrcl::it)
                  (push
                   (make-instance 'sstre1 :ui (ensure-integer (nth 0 tuple))
                                  :ui2 ui2
@@ -986,10 +986,10 @@ eliminate duplicates."
                (nreverse results))))
 
 (defun find-sstr-rl (rl)
-  (gu:awhen (mutex-sql-query 
+  (kmrcl:awhen (mutex-sql-query 
               (format nil "select STY_RL,STY_RL2,LS from SRSTRE where RL='~a'" rl))
              (let ((results '()))
-               (dolist (tuple gu::it)
+               (dolist (tuple kmrcl::it)
                  (push
                   (make-instance 'sstr 
                                  :rl rl
@@ -1001,10 +1001,10 @@ eliminate duplicates."
 
 
 (defun find-sstre2-sty (sty)
-  (gu:awhen (mutex-sql-query 
+  (kmrcl:awhen (mutex-sql-query 
             (format nil "select RL,STY2 from SRSTRE2 where STY='~a'" sty))
            (let ((results '()))
-             (dolist (tuple gu::it)
+             (dolist (tuple kmrcl::it)
                (push
                 (make-instance 'sstre2
                                :sty (copy-seq sty)
@@ -1014,10 +1014,10 @@ eliminate duplicates."
                (nreverse results))))
 
 (defun find-sstr-styrl (styrl)
-  (gu:awhen (mutex-sql-query 
+  (kmrcl:awhen (mutex-sql-query 
               (format nil "select RL,STY_RL2,LS from SRSTR where RL='~a'" styrl))
              (let ((results '()))
-               (dolist (tuple gu::it)
+               (dolist (tuple kmrcl::it)
                  (push
                   (make-instance 'sstr :styrl styrl
                                  :rl (nth 0 tuple)
index b83899c3250b509f7018d764e5a1072c4b2a3060..2cd4756979d97821914e162a842df16f190813d7 100644 (file)
@@ -1,5 +1,5 @@
 ;;;;  -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; $Id: umlisp.asd,v 1.2 2002/10/08 22:08:56 kevin Exp $
+;;;; $Id: umlisp.asd,v 1.3 2002/10/09 00:34:47 kevin Exp $
 
 (in-package :asdf)
 
@@ -14,5 +14,9 @@
       (:file "parse-common"  :depends-on ("parse-2002"))
       (:file "classes" :depends-on ("utils"))
       (:file "sql-classes" :depends-on ("classes" "sql"))
-      (:file "composite" :depends-on ("sql-classes"))))
+      (:file "composite" :depends-on ("sql-classes")))
+     :depends-on (:kmrcl
+                 :clsql-mysql
+                 :clsql)
+     )