r11333: add uconso object; query MRXW filtering by SAB

diff --git a/classes.lisp b/classes.lisp
index 94c489b8313f8b6103006783d34fbfa5fe50864b..efa685feab503a063bbe5e03b58d5eb8964cd77b 100644 (file)
--- a/classes.lisp
+++ b/classes.lisp
@@ -37,7 +37,7 @@
   ((rank :value-type fixnum :initarg :rank :reader rank)
    (sab :value-type string :initarg :sab :reader sab)
    (tty :value-type string :initarg :tty :reader tty)
-   (suppres :value-type string :initarg :suppres :reader suppres))
+   (suppress :value-type string :initarg :suppress :reader suppress))
   (:metaclass hyperobject-class)
   (:user-name "Rank")
   (:default-print-slots rank sab tty suppres))
@@ -265,6 +265,49 @@
   (:user-name "Concept")
   (:default-print-slots cui lrl pfstr))
 
+
+(defclass uconso (umlsclass)
+  ((cui :value-type fixnum :initarg :cui :reader cui :print-formatter fmt-cui
+       :hyperlink find-ucon-cui)
+   (lat :value-type string :initarg :lat :reader lat)
+   (ts :value-type string :initarg :ts :reader ts)
+   (lui :value-type fixnum :initarg :lui :reader lui :print-formatter fmt-lui)
+   (stt :value-type string :initarg :stt :reader stt)
+   (sui :value-type fixnum :initarg :sui :reader sui :print-formatter fmt-sui)
+   (ispref :value-type string :initarg :ispref :reader ispref)
+   (aui :value-type fixnum :initarg :aui :reader aui :print-formatter fmt-aui)
+   (saui :value-type string :initarg :saui :reader saui)
+   (scui :value-type string :initarg :scui :reader scui)
+   (sdui :value-type string :initarg :sdui :reader sdui)
+   (sab :value-type string :initarg :sab :reader sab)
+   (tty :value-type string :initarg :tty :reader tty)
+   (code :value-type string :initarg :code :reader code)
+   (str :value-type string :initarg :str :reader str)
+   (srl :value-type fixnum :initarg :srl :reader srl)
+   (suppress :value-type string :initarg :suppress :reader suppress)
+   (cvf :value-type string :initarg :cvf :reader cvf)
+   (kpfeng :value-type string :initarg :kpfeng :reader kpfeng)
+   (kcuisui :value-type bigint :initarg :kcuisui :reader kcuisui)
+   (kcuilui :value-type bigint :initarg :kcuilui :reader kcuilui)
+   (kcuilrl :value-type fixnum :initarg :kcuilrl :reader kcuilrl)
+   (kluilrl :value-type fixnum :initarg :kluilrl :reader kluilrl)
+   (ksuilrl :value-type fixnum :initarg :ksuilrl :reader ksuilrl)
+   (s#def :reader s#def :subobject (find-udef-cui cui))
+   (s#so :reader s#so :subobject (find-uso-cui cui))
+   (s#hier :reader s#hier :subobject (find-uhier-cui cui))
+   (s#map :reader s#map :subobject (find-umap-cui cui))
+   (s#smap :reader s#smap :subobject (find-usmap-cui cui))
+   (s#sty :reader s#sty :subobject (find-usty-cui cui))
+   (s#lo :reader s#lo :subobject (find-ulo-cui cui))
+   (s#term :reader s#term :subobject (find-uterm-cui cui))
+   (s#sat :reader s#sat :subobject (find-usat-ui cui))
+   (s#rel :reader s#rel :subobject (find-urel-cui cui))
+   (s#coc :reader s#coc :subobject (find-ucoc-cui cui)))
+  (:documentation "CONSO is a new concept from the RRF files. This object is a rather raw row from the MRCONSO table.")
+  (:metaclass hyperobject-class)
+  (:user-name "Concept")
+  (:default-print-slots cui lrl str sab))
+
 (defclass umap (umlsclass)
   ((mapsetcui :value-type fixnum :initarg :mapsetcui :reader mapsetcui)
    (mapsetsab :value-type string :initarg :mapsetsab :reader mapsetsab)

diff --git a/package.lisp b/package.lisp
index 1d39df0e2f810ef7fa70a0784fa9a4c06d957483..6e21f7a8a7cd6c04d64682750425d3413104fced 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -31,8 +31,8 @@
        #:urel #:ucoc #:usty #:uxw #:uxnw  #:uxns
        #:lexterm #:labr #:lagr #:lcmp #:lmod #:lnom #:lprn #:lprp #:lspl #:ltrm
        #:ltyp #:lwd #:sdef #:sstr #:sstre1 #:sstre2
-       #:sty #:tui #:def #:sab #:srl #:tty #:rank #:supres #:atn #:atv #:vcui
-       #:rcui #:vsab #:code #:saui :scui :sdui
+       #:sty #:tui #:def #:sab #:srl #:tty #:rank #:suppres #:atn #:atv #:vcui
+       #:rcui #:vsab #:code #:saui #:scui #:sdui #:ispref 
        #:rl #:sty2 #:ui #:ui2 #:ui3 #:eui #:bas #:eui2 #:bas2 #:rui
        #:cui #:aui #:lui #:sui #:wd #:lat #:nstr :cuilist
        #:rsab #:lat
@@ -40,6 +40,7 @@
        #:s#so #:s#cxt
        #:pfstr #:pfstr2 #:lrl #:def #:ts #:cui1 #:cui2 #:rela #:sl #:mg #:rel
        #:soc #:cot #:cof #:coa #:isn #:fr #:un #:sna #:soui #:hcd #:stt #:str
+       #:kpfeng :cvf
 
    ;; From class-support.lisp
    #:ucon-has-tui
@@ -89,6 +90,7 @@
    #:suistr
    #:print-umlsclass
    #:find-ucon-cui #:make-ucon-cui
+   #:find-uconso-cui
    #:find-ucon-lui
    #:find-ucon-sui
    #:find-ucon-cuisui

diff --git a/sql-classes.lisp b/sql-classes.lisp
index 20ef37eafe82939234e727cfa8441c18f3edfa97..54519a02f44aca7943b91e76880378a164ad7ec6 100644 (file)
--- a/sql-classes.lisp
+++ b/sql-classes.lisp
@@ -230,7 +230,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
     (make-instance 'ucon :cui cui)))
   
 (defun find-ucon-cui (cui &key (srl *current-srl*) without-pfstr)
-  "Find ucon for a cui"
+  "Find ucon for a cui. If set SAB, the without-pfstr is on by default"
   (ensure-cui-integer cui)
   (unless cui (return-from find-ucon-cui nil))
 
@@ -246,6 +246,20 @@ 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*))
+  "Find ucon for a cui. If set SAB, the without-pfstr is on by default"
+  (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-pfstr-cui (cui &key (srl *current-srl*))
   "Find preferred string for a cui"
   (ensure-cui-integer cui)
@@ -725,6 +739,43 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
                                     :lrl 'klrl :order '(cui asc))
     (find-ucon-cui cui :srl srl)))
 
+(defun find-ucon-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.cui FROM MRCONSO c,MRXW_ENG x WHERE x.WD  ~A '~A' AND x.cui=c.cui AND ~A ~A"
+                       (if like "LIKE" "=")
+                       (clsql-sys::sql-escape-quotes word)
+                       (typecase sab
+                         (stringp 
+                          (format nil " c.sab='" (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 (make-instance 'ucon (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
+                         (stringp 
+                          (format nil " c.sab='" (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)))))
+           
+
 (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"
   (collect-umlisp-query-eval ('mrxnw_eng '(cui) srl 'nwd word :like like :distinct t
@@ -794,10 +845,10 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 ;;; Multiword lookup and score functions
 
 (defun find-uobj-multiword (str obj-lookup-fun sort-fun key srl
-                           only-exact-if-match limit)
+                                only-exact-if-match limit &key extra-lookup-args)
   (let ((uobjs '()))
     (dolist (word (delimited-string-to-list str #\space))
-      (setq uobjs (append uobjs (funcall obj-lookup-fun word :srl srl))))
+      (setq uobjs (append uobjs (apply obj-lookup-fun word :srl srl extra-lookup-args))))
     (let ((sorted
           (funcall sort-fun str
                    (delete-duplicates uobjs :test #'= :key key))))
@@ -816,9 +867,14 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 
 (defun find-ucon-multiword (str &key (srl *current-srl*)
                                     (only-exact-if-match t)
-                                     limit)
-  (find-uobj-multiword str #'find-ucon-word #'sort-score-pfstr-str
-                      #'cui srl only-exact-if-match limit))
+                                     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)))
 
 (defun find-uterm-multiword (str &key (srl *current-srl*)
                                      (only-exact-if-match t)
@@ -828,9 +884,14 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 
 (defun find-ustr-multiword (str &key (srl *current-srl*)
                                     (only-exact-if-match t)
-                                     limit)
-  (find-uobj-multiword str #'find-ustr-word #'sort-score-ustr-str
-                      #'sui srl only-exact-if-match limit))
+                                     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)))
 
 (defun sort-score-pfstr-str (str uobjs)
   "Return list of sorted and scored ucons. Score by match of str to ucon-pfstr"