X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=blobdiff_plain;f=sql-classes.lisp;h=d086fd4969689c1ecf9424ef17616be5314510e1;hp=cd676f1e5d53a4b595e89a0cecdcfb0b73b07356;hb=HEAD;hpb=cba592c185ee1b2e4eedc4aaa531495da79d897e diff --git a/sql-classes.lisp b/sql-classes.lisp index cd676f1..d086fd4 100644 --- a/sql-classes.lisp +++ b/sql-classes.lisp @@ -27,13 +27,13 @@ &key (lrl "KCUILRL") single distinct order like limit filter) (let* ((%%fields (format nil "SELECT ~A~{~:@(~A~)~^,~} FROM ~:@(~A~)" - (if distinct "DISTINCT " "") fields table)) + (if distinct "DISTINCT " "") (sqlname fields) table)) (%%order (if order (format nil " ORDER BY ~{~:@(~A~) ~(~A~)~^,~}" order) "")) (%%lrl (format nil " AND ~:@(~A~)<=" lrl)) (%%where (when where-name - (format nil " WHERE ~:@(~A~)~A" where-name + (format nil " WHERE ~:@(~A~)~A" (sqlname where-name) (if like " like " "")))) (%filter (gensym "FILTER-")) (%single (gensym "SINGLE-")) @@ -77,15 +77,15 @@ (concatenate 'string (format nil "SELECT ~A~{~:@(~A~)~^,~} FROM ~:@(~A~)" - (if distinct "DISTINCT " "") fields table) - (if where-name (format nil " WHERE ~:@(~A~)" where-name) "") + (if distinct "DISTINCT " "") (sqlname fields) table) + (if where-name (format nil " WHERE ~:@(~A~)" (sqlname where-name)) "") (if where-name (format nil (typecase where-value (number "='~D'") (null " IS NULL") (t - (if like " LINK '%~A%""='~A'"))) + (if like " LIKE '%~A%'" "='~A'"))) where-value) "") (if filter (concatenate 'string " AND " filter) nil) @@ -259,6 +259,18 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" :kcuisui kcuisui :kcuilui kcuilui :kcuilrl kcuilrl :kluilrl kluilrl :ksuilrl ksuilrl))) +(defun find-uconso-cuisui (cuisui &key sab (srl *current-srl*)) + "Find uconso for a cuisui." + (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 kcuisui cuisui + :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-code (code &key first sab (srl *current-srl*) (like nil)) "Return list of uconso objects that match code. Optional, filter for SAB. Optionally, use SQL's LIKE syntax" @@ -273,7 +285,8 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (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)) +;; (unless (and sui (stringp sab)) + (unless sui (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 @@ -332,16 +345,19 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (make-instance 'ucon :cui (ensure-integer cui) :pfstr (find-pfstr-cui cui) :lrl (ensure-integer kcuilrl)))) -(defun find-ucon-cuisui (cui sui &key (srl *current-srl*)) +(defun find-ucon-cuisui (cuisui &key (srl *current-srl*)) + "Find ucon for cui/sui" + (collect-umlisp-query (mrconso (cui kcuilrl) srl kcuisui cuisui) + (make-instance 'ucon :cui cui + :pfstr (find-pfstr-cui cui) + :lrl (ensure-integer kcuilrl)))) + +(defun find-ucon-cui-sui (cui sui &key (srl *current-srl*)) "Find ucon for cui/sui" (ensure-cui-integer cui) (ensure-sui-integer sui) (when (and cui sui) - (collect-umlisp-query (mrconso (kcuilrl) srl kcuisui - (make-cuisui cui sui)) - (make-instance 'ucon :cui cui - :pfstr (find-pfstr-cui cui) - :lrl (ensure-integer kcuilrl))))) + (find-ucon-cui-sui cui sui :srl srl))) (defun find-ucon-str (str &key (srl *current-srl*)) "Find ucon that are exact match for str" @@ -395,7 +411,8 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-udef-cui (cui &key (srl *current-srl*)) "Return a list of udefs for cui" (ensure-cui-integer cui) - (collect-umlisp-query (mrdef (sab def suppress) srl cui cui :lrl "KSRL") + (collect-umlisp-query (mrdef (sab def suppress) srl cui cui :lrl "KSRL" + :distinct t) (make-instance 'udef :sab sab :def def :suppress suppress))) (defun find-udoc-key (key) @@ -478,7 +495,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (mapcar #'cui1 (find-urel-cui2 cui2 :srl srl))) collect (find-ucon-cui cui :srl srl))) -(defun find-ucoc-cui (cui &key (srl *current-srl*)) +#+mrcoc (defun find-ucoc-cui (cui &key (srl *current-srl*)) "Return a list of ucoc for cui" (ensure-cui-integer cui) (collect-umlisp-query (mrcoc (aui1 cui2 aui2 sab cot cof coa) srl cui1 @@ -490,7 +507,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" :cot cot :cof (ensure-integer cof) :coa coa :sab sab :pfstr2 (find-pfstr-cui cui2)))) -(defun find-ucoc-cui2 (cui2 &key (srl *current-srl*)) +#+mrcoc (defun find-ucoc-cui2 (cui2 &key (srl *current-srl*)) "Return a list of ucoc for cui2" (ensure-cui-integer cui2) (collect-umlisp-query (mrcoc (cui1 aui1 aui2 sab cot cof coa) srl cui2 @@ -501,7 +518,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" :sab sab :cot cot :cof (ensure-integer cof) :coa coa :pfstr2 (find-pfstr-cui cui2)))) -(defun find-ucon-coc-cui2 (cui2 &key (srl *current-srl*)) +#+mrcoc (defun find-ucon-coc-cui2 (cui2 &key (srl *current-srl*)) "List of ucon with co-occurance cui2" (ensure-cui-integer cui2) (mapcar @@ -540,26 +557,30 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (ensure-cui-integer cui) (ensure-lui-integer lui) (collect-umlisp-query (mrconso (sui stt str suppress ksuilrl) srl kcuilui - (make-cuilui cui lui) :lrl ksuilrl) + (make-cuilui cui lui) :lrl ksuilrl :distinct t) (make-instance 'ustr :sui (ensure-integer sui) :cui cui :lui lui :cuisui (make-cuisui cui sui) :stt stt :str str :suppress suppress :lrl (ensure-integer ksuilrl)))) -(defun find-ustr-cuisui (cui sui &key (srl *current-srl*)) +(defun find-ustr-cuisui (cuisui &key (srl *current-srl*)) "Return the single ustr for cuisui" - (ensure-cui-integer cui) - (ensure-sui-integer sui) - (collect-umlisp-query (mrconso (lui stt str suppress ksuilrl) srl kcuisui - (make-cuisui cui sui) :lrl lsuilrl :single t) - (make-instance 'ustr :sui sui :cui cui :cuisui (make-cuisui cui sui) + (collect-umlisp-query (mrconso (cui lui sui stt str suppress ksuilrl) srl kcuisui + cuisui :lrl ksuilrl :single t) + (make-instance 'ustr :sui sui :cui cui :cuisui cuisui :lui (ensure-integer lui) :stt stt :str str :suppress suppress :lrl (ensure-integer ksuilrl)))) +(defun find-ustr-cui-sui (cui sui &key (srl *current-srl*)) + "Return the single ustr for cuisui" + (ensure-cui-integer cui) + (ensure-sui-integer sui) + (find-ustr-cuisui (make-cuisui cui sui) :srl srl)) + (defun find-ustr-sui (sui &key (srl *current-srl*)) "Return the list of ustr for sui" (ensure-sui-integer sui) (collect-umlisp-query (mrconso (cui lui stt str suppress ksuilrl) srl sui sui - :lrl ksuilrl) + :lrl ksuilrl :distinct t) (make-instance 'ustr :sui sui :cui cui :stt stt :str str :cuisui (make-cuisui (ensure-integer cui) sui) :suppress suppress @@ -569,10 +590,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" "Return the list of ustr for sab" (collect-umlisp-query (mrconso (kcuisui) srl sab sab :lrl srl) (let ((cuisui (ensure-integer kcuisui))) - (apply #'find-ustr-cuisui - (append - (multiple-value-list (decompose-cuisui cuisui)) - (list :srl srl)))))) + (find-ustr-cuisui cuisui :srl srl)))) (defun find-ustr-all (&key (srl *current-srl*)) "Return list of all ustr's" @@ -602,28 +620,28 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-uso-cuisui (cui sui &key (srl *current-srl*)) (ensure-sui-integer sui) (ensure-cui-integer cui) - (collect-umlisp-query (mrconso (aui sab code srl tty saui sdui scui lat str) + (collect-umlisp-query (mrconso (aui sab code srl tty saui sdui scui lat str ts) srl kcuisui (make-cuisui cui sui) :lrl srl) (make-instance 'uso :aui aui :sab sab :code code :srl srl :tty tty :cui cui :sui sui :saui saui :sdui sdui :scui scui - :lat lat :str str))) + :lat lat :str str :ts ts))) (defun find-uso-cui (cui &key (srl *current-srl*) (english-only nil) limit) (ensure-cui-integer cui) - (collect-umlisp-query (mrconso (aui sab code srl tty saui sdui scui lat str sui) + (collect-umlisp-query (mrconso (aui sab code srl tty saui sdui scui lat str sui ts) srl cui cui :lrl srl :limit limit :filter (when english-only "LAT='ENG'")) (make-instance 'uso :aui aui :sab sab :code code :srl srl :tty tty :cui cui :sui sui :saui saui :sdui sdui :scui scui - :lat lat :str str))) + :lat lat :str str :ts ts))) (defun find-uso-aui (aui &key (srl *current-srl*)) (ensure-sui-integer aui) (collect-umlisp-query (mrconso (sab cui sui code srl tty saui sdui scui lat - str) srl aui aui :lrl srl :single t) + str ts) srl aui aui :lrl srl :single t) (make-instance 'uso :aui aui :cui cui :sab sab :code code :srl srl :tty tty :sui sui :saui saui :sdui sdui :scui scui :lat lat - :str str))) + :str str :ts ts))) (defun find-uhier-cui (cui &key (srl *current-srl*)) (ensure-cui-integer cui) @@ -691,13 +709,14 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" :cxty cxty :ttyl ttyl :atnl atnl :lat lat :cenc cenc :curver curver :sabin sabin :ssn ssn :scit scit))) -(defun find-usab-by-key (key-name key) +(defun find-usab-by-key (key-name key &key current) "Find usab for a key" (collect-umlisp-query-eval ('mrsab '(vcui rcui vsab rsab son sf sver vstart vend imeta rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc curver sabin ssn scit) - nil key-name key :single t) + nil key-name key :single t + :filter (when current "RMETA=''")) (make-instance 'usab :vcui (ensure-integer vcui) :rcui (ensure-integer rcui) :vsab vsab :rsab rsab :son son :sf sf :sver sver :vstart vstart :vend vend :imeta imeta @@ -707,11 +726,11 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" :curver curver :sabin sabin :ssn ssn :scit scit))) -(defun find-usab-rsab (rsab) +(defun find-usab-rsab (rsab &key (current t)) "Find usab for rsab" (find-usab-by-key 'rsab rsab)) -(defun find-usab-vsab (vsab) +(defun find-usab-vsab (vsab &key (current t)) "Find usab for vsab" (find-usab-by-key 'vsab vsab)) @@ -787,9 +806,9 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (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))))) + (collect-umlisp-query-eval ('mrxw_eng '(kcuisui) srl 'wd word :like like + :lrl 'klrl :order '(kcuisui asc)) + (find-uconso-cuisui kcuisui :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" @@ -825,7 +844,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" "Return list of cui that match word, optionally use SQL's LIKE syntax" (collect-umlisp-query-eval ('mrxnw_eng '(sui) srl 'nwd word :like like :distinct t :lrl 'klrl :order '(cui asc)) - sui)) + sui)) (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" @@ -844,19 +863,19 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" "")) (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))))) + 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 + (collect-umlisp-query (mrxw_eng (kcuisui) srl wd word :lrl klrl :order (cui asc sui asc)) - (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl))))) + (find-ustr-cuisui kcuisui :srl srl))))) (defun find-ustr-normalized-word (word &key (srl *current-srl*)) "Return list of ustrs that match word" - (collect-umlisp-query (mrxnw_eng (cui sui) srl nwd word :lrl klrl + (collect-umlisp-query (mrxnw_eng (kcuisui) srl nwd word :lrl klrl :order (cui asc sui asc)) - (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl))) + (find-ustr-cuisui kcuisui :srl srl))) (defun find-uterm-word (word &key (srl *current-srl*)) "Return list of uterms that match word" @@ -878,9 +897,9 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-ustr-noneng-word (word &key (srl *current-srl*)) "Return list of ustrs that match non-english word" - (collect-umlisp-query (mrxw_noneng (cui sui) srl wd word :lrl klrl + (collect-umlisp-query (mrxw_noneng (kcuisui) srl wd word :lrl klrl :order (cui asc sui asc)) - (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl))) + (find-ustr-cuisui kcuisui :srl srl))) ;; Special tables @@ -894,7 +913,8 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" only-exact-if-match limit &key extra-lookup-args) (let ((uobjs '())) (dolist (word (delimited-string-to-list str #\space)) - (setq uobjs (append uobjs (apply obj-lookup-fun word :srl srl extra-lookup-args)))) + (setq uobjs (nconc uobjs + (kmrcl:flatten (apply obj-lookup-fun word :srl srl extra-lookup-args))))) (let ((sorted (funcall sort-fun str (delete-duplicates uobjs :test #'= :key key)))) @@ -1072,37 +1092,8 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" ;;; ************************** -(defun make-ustats () - (with-sql-connection (conn) - (ignore-errors (sql-execute "drop table USTATS" conn)) - (sql-execute "create table USTATS (NAME varchar(160), COUNT bigint, SRL integer)" conn) - - (dotimes (srl 5) - (insert-ustats-count conn "Concept Count" "MRCONSO" "distinct CUI" "KCUILRL" srl) - (insert-ustats-count conn "Term Count" "MRCONSO" "distinct KCUILUI" "KCUILRL" srl) - (insert-ustats-count conn "Distinct Term Count" "MRCONSO" "distinct LUI" "KLUILRL" srl) - (insert-ustats-count conn "String Count" "MRCONSO" "*" "KSUILRL" srl) - (insert-ustats-count conn "Distinct String Count" "MRCONSO" "distinct SUI" "KSUILRL" srl) - (insert-ustats-count conn "Hierarchcy" "MRHIER" "*" "KSRL" srl) - (insert-ustats-count conn "Mappings" "MRMAP" "*" "KSRL" srl) - (insert-ustats-count conn "Simple Mappings" "MRSMAP" "*" "KSRL" srl) - (insert-ustats-count conn "Co-occuring Concept Count" "MRCOC" "*" "KLRL" srl) - (insert-ustats-count conn "Definition Count" "MRDEF" "*" "KSRL" srl) - (insert-ustats-count conn "Rank Count" "MRRANK" "*" "KSRL" srl) - (insert-ustats-count conn "Relationship Count" "MRREL" "*" "KSRL" srl) - (insert-ustats-count conn "Semantic Type Count" "MRSTY" "*" "KLRL" srl) - (insert-ustats-count conn "Simple Attribute Count" "MRSAT" "*" "KSRL" srl) - (insert-ustats-count conn "Source Abbreviation Count" "MRSAB" "*" "SRL" srl) - (insert-ustats-count conn "Word Index Count" "MRXW_ENG" "*" "KLRL" srl) - (insert-ustats-count conn "Normalized Word Index Count" "MRXNW_ENG" "*" "KLRL" srl) - (insert-ustats-count conn "Normalized String Index Count" "MRXNS_ENG" "*" "KLRL" srl)) - (sql-execute "create index USTATS_SRL on USTATS (SRL)" conn)) - (find-ustats-all)) - -(defun insert-ustats-count (conn name table count-variable srl-control srl) - (insert-ustats conn name (find-count-table conn table srl count-variable srl-control) srl)) - (defun find-count-table (conn table srl count-variable srl-control) + (with-sql-connection (conn) (cond ((stringp srl-control) (ensure-integer @@ -1116,7 +1107,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" conn)))) (t (error "Unknown srl-control") - 0))) + 0)))) (defun insert-ustats (conn name count srl) (sql-execute (format nil "insert into USTATS (name,count,srl) values ('~a',~d,~d)" @@ -1140,3 +1131,13 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (collect-umlisp-query (ustats (name count) nil srl srl :order (name asc)) (make-instance 'ustats :name name :hits (ensure-integer count)))) +(defun find-urank-sab (sab &key (srl *current-srl*)) + (collect-umlisp-query (mrrank (rank sab suppress tty) nil sab sab) + (make-instance 'urank :rank rank :sab sab :tty tty :suppress suppress))) + +(defun find-urank-all (&key (srl *current-srl*)) + (if srl + (collect-umlisp-query (mrrank (rank sab suppress tty) nil ksrl srl) + (make-instance 'urank :rank rank :sab sab :tty tty :suppress suppress)) + (collect-umlisp-query (mrrank (rank sab suppress tty ksrl) nil nil nil) + (make-instance 'urank :rank rank :sab sab :tty tty :suppress suppress))))