From: Kevin M. Rosenberg Date: Wed, 9 Oct 2002 00:34:47 +0000 (+0000) Subject: r2953: *** empty log message *** X-Git-Tag: v2006ac.2~333 X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=commitdiff_plain;h=f513e7b50135115f3c56b840c2cb0d1c9c8ffa82 r2953: *** empty log message *** --- diff --git a/composite.lisp b/composite.lisp index d31c513..611dfd1 100644 --- a/composite.lisp +++ b/composite.lisp @@ -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)) @@ -124,8 +124,8 @@ "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))))) @@ -157,15 +157,15 @@ (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) diff --git a/data-structures.lisp b/data-structures.lisp index d13b709..a52c97d 100644 --- a/data-structures.lisp +++ b/data-structures.lisp @@ -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* diff --git a/package.lisp b/package.lisp index 3bc20c1..9cd24db 100644 --- a/package.lisp +++ b/package.lisp @@ -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 diff --git a/parse-2002.lisp b/parse-2002.lisp index 3d6728f..6f593eb 100644 --- a/parse-2002.lisp +++ b/parse-2002.lisp @@ -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) @@ -161,7 +161,7 @@ ("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 diff --git a/sql-classes.lisp b/sql-classes.lisp index e193f8b..920ee8d 100644 --- a/sql-classes.lisp +++ b/sql-classes.lisp @@ -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*)) @@ -130,10 +130,10 @@ (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)) @@ -358,12 +358,12 @@ (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*)) @@ -391,14 +391,14 @@ (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*)) @@ -526,16 +526,16 @@ (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) diff --git a/umlisp.asd b/umlisp.asd index b83899c..2cd4756 100644 --- a/umlisp.asd +++ b/umlisp.asd @@ -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) + )