X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql-classes.lisp;h=2b468dc095080d61e621470005df128dbf1131b1;hb=6b0acc8fd6324c9a8000d224808a50a781ea8c74;hp=df23c492e224aae5812ddd15314655f4642534a1;hpb=e9815df2b42c20fbaf7529541147522a7c7cf238;p=umlisp.git diff --git a/sql-classes.lisp b/sql-classes.lisp index df23c49..2b468dc 100644 --- a/sql-classes.lisp +++ b/sql-classes.lisp @@ -23,17 +23,31 @@ (defun set-current-srl (srl) (setq *current-srl* srl)) +;; SQLNAME is required for collision of SQL reserved words (MYSQL 8: RANK) +;; and column names in UMLS (RANK in MRRANK) +(defvar *sql-reserved-names* '("RANK")) +(defmethod sqlname ((c ucol)) + (sqlname (col c))) +(defmethod sqlname ((name string)) + (if (find name *sql-reserved-names* :test #'string-equal) + (concatenate 'string "_" name) + name)) +(defmethod sqlname ((l list)) + (mapcar #'sqlname l)) +(defmethod sqlname ((s symbol)) + (sqlname (symbol-name s))) + (defmacro query-string (table fields srl where-name where-value &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 +91,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 @@ -495,7 +509,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 @@ -507,7 +521,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 @@ -518,7 +532,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 @@ -1092,37 +1106,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 @@ -1136,7 +1121,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)" @@ -1159,3 +1144,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))))