X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=blobdiff_plain;f=sql-classes.lisp;h=87d59bfeff89409b1a11e710afd14869fc12c4f2;hp=2805b8017172b55291765589176f7d7627c9ec1b;hb=28aeae6f894ac1e2b4ded59af9371b373e38a701;hpb=f2f3771917e7d8c2999615d3f30641c8ee251872 diff --git a/sql-classes.lisp b/sql-classes.lisp index 2805b80..87d59bf 100644 --- a/sql-classes.lisp +++ b/sql-classes.lisp @@ -20,7 +20,7 @@ (defvar *current-srl* nil) (defun current-srl () *current-srl*) -(defun (setf current-srl) (srl) +(defun set-current-srl (srl) (setq *current-srl* srl)) (defmacro query-string (table fields srl where-name where-value @@ -85,7 +85,7 @@ (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" @@ -332,16 +344,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" @@ -545,16 +560,20 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" :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 lsuilrl :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) @@ -569,10 +588,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 +618,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 +707,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 +724,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 +804,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 +842,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 +861,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 +895,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 +911,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)))) @@ -1077,7 +1095,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (ignore-errors (sql-execute "drop table USTATS" conn)) (sql-execute "create table USTATS (NAME varchar(160), COUNT bigint, SRL integer)" conn) - (dotimes (srl 5) + (dolist (srl '(0 1 2 3 4 9)) (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)