X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql-classes.lisp;h=d1e19f3fea74dd3a36293dab1793f3b24250fad4;hb=ab8b9c83accebd43e817e1d5cee6a8f7fb9a7eab;hp=87d59bfeff89409b1a11e710afd14869fc12c4f2;hpb=cb84d39847530c3317d03230eb82af671c71ef79;p=umlisp.git diff --git a/sql-classes.lisp b/sql-classes.lisp index 87d59bf..d1e19f3 100644 --- a/sql-classes.lisp +++ b/sql-classes.lisp @@ -285,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 @@ -410,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) @@ -493,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 @@ -505,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 @@ -516,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 @@ -555,7 +557,7 @@ 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)))) @@ -563,7 +565,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-ustr-cuisui (cuisui &key (srl *current-srl*)) "Return the single ustr for cuisui" (collect-umlisp-query (mrconso (cui lui sui stt str suppress ksuilrl) srl kcuisui - cuisui :lrl lsuilrl :single t) + 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)))) @@ -578,7 +580,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" "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 @@ -1090,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) - - (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) - (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 @@ -1134,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)" @@ -1157,4 +1130,3 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-ustats-srl (srl) (collect-umlisp-query (ustats (name count) nil srl srl :order (name asc)) (make-instance 'ustats :name name :hits (ensure-integer count)))) -