X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=blobdiff_plain;f=sql-classes.lisp;h=8031ace4553584dfdf6f2e3411881cdae0f41bd8;hp=9722be4f830a388f4bb93f694f9412cf07d4bfe0;hb=5f22946ec144f413cd4306bc60daad9658fced72;hpb=df3f1e082db2eef97864279414df97ba57f8b371 diff --git a/sql-classes.lisp b/sql-classes.lisp index 9722be4..8031ace 100644 --- a/sql-classes.lisp +++ b/sql-classes.lisp @@ -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" @@ -788,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" @@ -826,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" @@ -845,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" @@ -879,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 @@ -895,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 (append 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)))) @@ -1078,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)