From e4ea77e0121111b1edeb6a8698f3bffcc3e4e0a6 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Mon, 9 Apr 2007 16:52:33 +0000 Subject: [PATCH] r11612: rework find-*-sab functions to reuse main find-* function with SAB as an optional filter. Add find-uconso-code --- package.lisp | 2 + sql-classes.lisp | 180 +++++++++++++++++++++-------------------------- tests/parse.lisp | 3 +- 3 files changed, 85 insertions(+), 100 deletions(-) diff --git a/package.lisp b/package.lisp index 45bb26c..604ea7d 100644 --- a/package.lisp +++ b/package.lisp @@ -90,6 +90,8 @@ #:print-umlsclass #:find-ucon-cui #:make-ucon-cui #:find-uconso-cui + #:find-uconso-sui + #:find-uconso-code #:find-ucon-lui #:find-ucon-sui #:find-ucon-cuisui diff --git a/sql-classes.lisp b/sql-classes.lisp index d434e94..e0f6c43 100644 --- a/sql-classes.lisp +++ b/sql-classes.lisp @@ -246,46 +246,31 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (make-instance 'ucon :cui cui :pfstr str :lrl kcuilrl)))) -(defun find-uconso-cui (cui &key (srl *current-srl*)) +(defun find-uconso-cui (cui &key sab (srl *current-srl*)) "Find uconso for a cui." (ensure-cui-integer cui) (unless cui (return-from find-uconso-cui nil)) - (collect-umlisp-query (mrconso (lat ts lui stt sui ispref aui saui scui sdui sab tty code str - srl suppress cvf kpfeng kcuisui kcuilui kcuilrl - kluilrl ksuilrl) srl cui cui) - (make-instance 'uconso :cui cui :lat lat :ts ts :lui lui :stt stt :sui sui :ispref ispref - :aui aui :saui saui :scui scui :sdui sdui :sab sab :tty tty :code code - :str str :srl srl :suppress suppress :cvf cvf :kpfeng kpfeng - :kcuisui kcuisui :kcuilui kcuilui :kcuilrl kcuilrl :kluilrl kluilrl - :ksuilrl ksuilrl))) - -(defun find-uconso-cui-sab (cui sab &key (srl *current-srl*)) - "Find uconso for a cui. If set SAB, the without-pfstr is on by default" - (ensure-cui-integer cui) - (unless (and cui (stringp sab)) - (return-from find-uconso-cui-sab nil)) - (collect-umlisp-query (mrconso (lat ts lui stt sui ispref aui saui scui sdui sab tty code str srl suppress cvf kpfeng kcuisui kcuilui kcuilrl kluilrl ksuilrl) srl cui cui - :filter (concatenate 'string "SAB='" sab "'")) + :filter (if sab (concatenate 'string "SAB='" sab "'") nil)) (make-instance 'uconso :cui cui :lat lat :ts ts :lui lui :stt stt :sui sui :ispref ispref :aui aui :saui saui :scui scui :sdui sdui :sab sab :tty tty :code code :str str :srl srl :suppress suppress :cvf cvf :kpfeng kpfeng :kcuisui kcuisui :kcuilui kcuilui :kcuilrl kcuilrl :kluilrl kluilrl :ksuilrl ksuilrl))) -(defun find-uconso-sui-sab (sui sab &key (srl *current-srl*)) +(defun find-uconso-sui (sui &key sab (srl *current-srl*)) "Find uconso for a sui. If set SAB, the without-pfstr is on by default" (ensure-sui-integer sui) (unless (and sui (stringp sab)) - (return-from find-uconso-sui-sab nil)) + (return-from find-uconso-sui nil)) (collect-umlisp-query (mrconso (cui lat ts lui stt sui ispref aui saui scui sdui sab tty code str srl suppress cvf kpfeng kcuisui kcuilui kcuilrl kluilrl ksuilrl) srl sui sui - :filter (concatenate 'string "SAB='" sab "'")) + :filter (if sab (concatenate 'string "SAB='" sab "'") nil)) (make-instance 'uconso :cui cui :lat lat :ts ts :lui lui :stt stt :sui sui :ispref ispref :aui aui :saui saui :scui scui :sdui sdui :sab sab :tty tty :code code :str str :srl srl :suppress suppress :cvf cvf :kpfeng kpfeng @@ -754,79 +739,66 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (collect-umlisp-query (mrsty (cui) srl tui tui :lrl klrl :order (cui asc)) (find-ucon-cui (ensure-integer cui) :srl srl))) -(defun find-ucon-word (word &key (srl *current-srl*) (like nil)) - "Return list of ucons that match word. Optionally, use SQL's LIKE syntax" - (collect-umlisp-query-eval ('mrxw_eng '(cui) srl 'wd word :like like :distinct t - :lrl 'klrl :order '(cui asc)) - (find-ucon-cui cui :srl srl))) - -(defun find-uconso-word (word &key (srl *current-srl*) (like nil)) - "Return list of uconso objects that match word. Optionally, use SQL's LIKE syntax" - (collect-umlisp-query-eval ('mrxw_eng '(cui) srl 'wd word :like like :distinct t - :lrl 'klrl :order '(cui asc)) - (find-uconso-cui cui :srl srl))) +(defun find-uconso-code (code &key sab (srl *current-srl*) (like nil)) + "Return list of uconso objects that match code. Optional, filter for SAB. Optionally, use SQL's LIKE syntax" + (collect-umlisp-query (mrconso (sui sab) srl code code :like like :distinct t + :lrl klrl + :filter (if sab (concatenate 'string "SAB='" sab "'") nil)) + (find-uconso-sui sui :sab sab :srl srl))) (defun mrconso-query-word-cui (word sab srl like) - (format nil "SELECT DISTINCT c.cui FROM MRCONSO c,MRXW_ENG x WHERE x.WD ~A '~A' AND x.cui=c.cui AND ~A ~A" - (if like "LIKE" "=") + (format nil "SELECT DISTINCT c.cui FROM MRCONSO c,MRXW_ENG x WHERE x.WD~A'~A' AND x.cui=c.cui~A~A" + (if like " LIKE " "=") (clsql-sys::sql-escape-quotes word) (etypecase sab (string - (format nil " c.sab='~A'" (clsql-sys::sql-escape-quotes sab))) + (format nil " AND c.sab='~A'" (clsql-sys::sql-escape-quotes sab))) (cons - (format nil " c.sab IN (~{'~A'~^,~})" + (format nil " AND c.sab IN (~{'~A'~^,~})" (mapcar 'clsql-sys::sql-escape-quotes sab))) (null - (error "SAB missing"))) - (if srl (format nil "AND KCUILRL <= ~A" srl) ""))) + "")) + (if srl (format nil " AND KCUILRL <= ~A" srl) ""))) (defun mrconso-query-word-sui (word sab srl like) - (format nil "SELECT DISTINCT c.sui FROM MRCONSO c,MRXW_ENG x WHERE x.WD ~A '~A' AND x.sui=c.sui AND ~A ~A" - (if like "LIKE" "=") + (format nil "SELECT DISTINCT c.sui FROM MRCONSO c,MRXW_ENG x WHERE x.WD~A'~A' AND x.sui=c.sui~A~A" + (if like " LIKE " "=") (clsql-sys::sql-escape-quotes word) (etypecase sab (string - (format nil " c.sab='~A'" (clsql-sys::sql-escape-quotes sab))) + (format nil " AND c.sab='~A'" (clsql-sys::sql-escape-quotes sab))) (cons - (format nil " c.sab IN (~{'~A'~^,~})" + (format nil " AND c.sab IN (~{'~A'~^,~})" (mapcar 'clsql-sys::sql-escape-quotes sab))) (null - (error "SAB missing"))) - (if srl (format nil "AND KCUILRL <= ~A" srl) ""))) - -(defun find-uconso-word-sab (word &key sab (srl *current-srl*) (like nil)) - "Return list of uconso that match word in matching SAB. Optionally, use SQL's LIKE syntax" - (let ((sui-query (mrconso-query-word-sui word sab srl like)) - (uconsos nil)) - (dolist (sui (remove-duplicates (sort (mapcar 'car (mutex-sql-query sui-query)) #'<))) - (setq uconsos (nconc uconsos (find-uconso-sui-sab sui sab)))) - (remove-duplicates uconsos :key 'cui))) - -(defun find-ucon-word-sab (word &key sab (srl *current-srl*) (like nil)) - "Return list of ucon that match word in matching SAB. Optionally, use SQL's LIKE syntax" - (let ((query (mrconso-query-word-cui word sab srl like))) - (loop for tuple in (mutex-sql-query query) - collect (make-instance 'ucon :cui (first tuple))))) - -(defun find-ustr-word-sab (word &key sab (srl *current-srl*) (like nil)) - "Return list of ustr that match word in matching SAB. Optionally, use SQL's LIKE syntax" - (let ((query (format nil "SELECT c.sui,c.cui,c.lui,c.str,c.lrl,c.stt,c.suppress,c.cuisui FROM MRCONSO c,MRXW_ENG x WHERE x.WD ~A '~A' AND x.cui=c.cui AND x.lui=c.lui AND x.sui=c.sui AND ~A ~A" - (if like "LIKE" "=") - (clsql-sys::sql-escape-quotes word) - (typecase sab - (string - (format nil " c.sab='~A'" (clsql-sys::sql-escape-quotes sab))) - (cons - (format nil " c.sab IN (~('~A'~^,~))" - (mapcar 'clsql-sys::sql-escape-quotes sab))) - (t - (error "SAB missing"))) - (if srl (format nil "AND KCUILRL <= ~D" srl) "")))) - (loop for tuple in (mutex-sql-query query) - collect (destructuring-bind (sui cui lui str lrl stt suppress cuisui) tuple - (make-instance 'ustr :sui sui :cui cui :lui lui :str str :lrl lrl - :stt stt :suppress suppress :cuisui cuisui))))) + "")) + (if srl (format nil " AND KCUILRL <= ~A" srl) ""))) +(defun find-uconso-word (word &key sab (srl *current-srl*) (like nil)) + "Return list of uconso that match word. Optionally, matching SAB. Optionally, use SQL's LIKE syntax" + (cond + (sab + (let ((sui-query (mrconso-query-word-sui word sab srl like)) + (uconsos nil)) + (dolist (sui (remove-duplicates (sort (mapcar 'car (mutex-sql-query sui-query)) #'<))) + (setq uconsos (nconc uconsos (find-uconso-sui sui :sab sab)))) + (remove-duplicates uconsos :key 'cui))) + (t + (collect-umlisp-query-eval ('mrxw_eng '(cui) srl 'wd word :like like :distinct t + :lrl 'klrl :order '(cui asc)) + (find-uconso-cui cui :srl srl))))) + +(defun find-ucon-word (word &key sab (srl *current-srl*) (like nil)) + "Return list of ucon that match word in matching SAB. Optionally, use SQL's LIKE syntax" + (cond + (sab + (let ((query (mrconso-query-word-cui word sab srl like))) + (loop for tuple in (mutex-sql-query query) + collect (make-instance 'ucon :cui (first tuple))))) + (t + (collect-umlisp-query-eval ('mrxw_eng '(cui) srl 'wd word :like like :distinct t + :lrl 'klrl :order '(cui asc)) + (find-ucon-cui cui :srl srl))))) (defun find-ucon-normalized-word (word &key (srl *current-srl*) (like nil)) "Return list of ucons that match word, optionally use SQL's LIKE syntax" @@ -852,11 +824,30 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" :lrl 'klrl :order '(cui asc)) sui)) -(defun find-ustr-word (word &key (srl *current-srl*)) - "Return list of ustrs that match word" - (collect-umlisp-query (mrxw_eng (cui sui) srl wd word :lrl klrl - :order (cui asc sui asc)) - (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl))) +(defun find-ustr-word (word &key sab (srl *current-srl*) (like nil)) + "Return list of ustr that match word in matching SAB. Optionally, use SQL's LIKE syntax" + (cond + (sab + (let ((query (format nil "SELECT c.sui,c.cui,c.lui,c.str,c.lrl,c.stt,c.suppress,c.cuisui FROM MRCONSO c,MRXW_ENG x WHERE x.WD ~A '~A' AND x.cui=c.cui AND x.lui=c.lui AND x.sui=c.sui~A~A" + (if like "LIKE" "=") + (clsql-sys::sql-escape-quotes word) + (typecase sab + (string + (format nil " AND c.sab='~A'" (clsql-sys::sql-escape-quotes sab))) + (cons + (format nil " AND c.sab IN (~('~A'~^,~))" + (mapcar 'clsql-sys::sql-escape-quotes sab))) + (null + "")) + (if srl (format nil " AND KCUILRL <= ~D" srl) "")))) + (loop for tuple in (mutex-sql-query query) + collect (destructuring-bind (sui cui lui str lrl stt suppress cuisui) tuple + (make-instance 'ustr :sui sui :cui cui :lui lui :str str :lrl lrl + :stt stt :suppress suppress :cuisui cuisui))))) + (t + (collect-umlisp-query (mrxw_eng (cui sui) srl wd word :lrl klrl + :order (cui asc sui asc)) + (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl))))) (defun find-ustr-normalized-word (word &key (srl *current-srl*)) "Return list of ustrs that match word" @@ -921,23 +912,17 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (only-exact-if-match t) limit sab) - (if sab - (find-uobj-multiword str #'find-ucon-word-sab #'sort-score-pfstr-str - #'cui srl only-exact-if-match limit - :extra-lookup-args (list :sab sab)) - (find-uobj-multiword str #'find-ucon-word #'sort-score-pfstr-str - #'cui srl only-exact-if-match limit))) + (find-uobj-multiword str #'find-ucon-word #'sort-score-pfstr-str + #'cui srl only-exact-if-match limit + :extra-lookup-args (list :sab sab))) (defun find-uconso-multiword (str &key (srl *current-srl*) (only-exact-if-match t) limit sab) - (if sab - (find-uobj-multiword str #'find-uconso-word-sab #'sort-score-pfstr-str - #'cui srl only-exact-if-match limit - :extra-lookup-args (list :sab sab)) - (find-uobj-multiword str #'find-uconso-word #'sort-score-pfstr-str - #'cui srl only-exact-if-match limit))) + (find-uobj-multiword str #'find-uconso-word #'sort-score-pfstr-str + #'cui srl only-exact-if-match limit + :extra-lookup-args (list :sab sab))) (defun find-uterm-multiword (str &key (srl *current-srl*) (only-exact-if-match t) @@ -949,12 +934,9 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (only-exact-if-match t) limit sab) - (if sab - (find-uobj-multiword str #'find-ustr-word-sab #'sort-score-ustr-str - #'sui srl only-exact-if-match limit - :extra-lookup-args (list :sab sab)) - (find-uobj-multiword str #'find-ustr-word #'sort-score-ustr-str - #'sui srl only-exact-if-match limit))) + (find-uobj-multiword str #'find-ustr-word #'sort-score-ustr-str + #'sui srl only-exact-if-match limit + :extra-lookup-args (list :sab sab))) (defun sort-score-pfstr-str (str uobjs) "Return list of sorted and scored ucons. Score by match of str to ucon-pfstr" diff --git a/tests/parse.lisp b/tests/parse.lisp index 9e1670a..83753b4 100644 --- a/tests/parse.lisp +++ b/tests/parse.lisp @@ -43,6 +43,7 @@ (umlisp::filename-to-tablename "TEST.AB.RRF") "TEST_AB"))) +;; specific for UMLS2007AA (when (probe-file (umlisp::umls-pathname "MRFILES.RRF")) (umlisp::ensure-ucols+ufiles) (setq @@ -51,7 +52,7 @@ *rt-parse* '( (deftest uparse.1 (length *umls-files*) 63) - (deftest uparse.2 (length *umls-cols*) 434) + (deftest uparse.2 (length *umls-cols*) 452) (deftest uparse.3 (sort (mapcar #'u::col (umlisp::ucols (umlisp::find-ufile "MRCONSO.RRF"))) #'string<) -- 2.34.1