X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=blobdiff_plain;f=sql-classes.lisp;h=d086fd4969689c1ecf9424ef17616be5314510e1;hp=b1373f004d8f14140bc9d1e5d10ed746a8e3f54d;hb=HEAD;hpb=0f17ab33885d41f4aceccb5d9281bd14d27d63a5 diff --git a/sql-classes.lisp b/sql-classes.lisp index b1373f0..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,8 +77,8 @@ (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 @@ -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)))) @@ -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)" @@ -1158,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))))