X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=blobdiff_plain;f=sql-classes.lisp;h=d1e19f3fea74dd3a36293dab1793f3b24250fad4;hp=78ae763f18e9a88b14c572612df4fc8c36e847b8;hb=HEAD;hpb=7f30522f16a7c528b5a0f0ee493bbb0cb1aef77b diff --git a/sql-classes.lisp b/sql-classes.lisp index 78ae763..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 @@ -411,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) @@ -494,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 @@ -506,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 @@ -517,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 @@ -1091,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 @@ -1135,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 +1130,14 @@ 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)))) + +(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))))