Add mysql utf8 collation, new lookup functions

diff --git a/create-sql.lisp b/create-sql.lisp
index 88fa898fb89814d881ec3b1c6b3fbe551551fc02..544267c4037b2efb1789afc27cedeaac912ebc90 100644 (file)
--- a/create-sql.lisp
+++ b/create-sql.lisp
@@ -44,7 +44,7 @@
                 " MAX_ROWS=200000000"
               "")
             (if (eq *umls-sql-type* :mysql)
-                " TYPE=MYISAM CHARACTER SET utf8"
+                " TYPE=MYISAM CHARACTER SET utf8 COLLATE utf8_bin"
                 ""))))
 
 (defun create-custom-table-cmd (tablename sql-cmd)

diff --git a/package.lisp b/package.lisp
index 9572374711612eea24e5584d82feeb1b070e3ed9..e8b4b4fc2c59fd9219507dc0380451f499ce8efa 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -1,4 +1,4 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: cl-user -*-
+;;;; -*- Mode: Lisp -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -97,9 +97,12 @@
          #:find-ucon-cui #:make-ucon-cui
          #:find-uconso-cui
          #:find-uconso-sui
+         #:find-uconso-cuisui
+         #:find-uconso-word
          #:find-uconso-code
          #:find-ucon-lui
          #:find-ucon-sui
+         #:find-ucon-cui-sui
          #:find-ucon-cuisui
          #:find-ucon-str
          #:find-ucon-all
@@ -111,6 +114,7 @@
          #:find-uterm-in-ucon
          #:find-ustr-cuilui
          #:find-ustr-cuisui
+         #:find-ustr-cui-sui
          #:find-ustr-sui
          #:find-ustr-sab
          #:find-ustr-all

diff --git a/parse-rrf.lisp b/parse-rrf.lisp
index efb897558a0aae6e0b6bc171c37799c8f743c484..3b02c7ff6203ac37275ebb9f064930b7815004c4 100644 (file)
--- a/parse-rrf.lisp
+++ b/parse-rrf.lisp
@@ -362,7 +362,7 @@ SNOMED SRL changed from 4 to 9. So we create a new scale ~
       ("CUI" "MRSTY")  ("TUI" "MRSTY") ("CUI" "MRXNS_ENG")
       ("AUI" "MRHIER") ("CUI" "MRHIER") ("CXN" "MRHIER") ("RELA" "MRHIER") ("PAUI" "MRHIER")
       ("SAB" "MRHIER")
-      #+ignore ("NSTR" "MRXNS_ENG" 10)
+      ("NSTR" "MRXNS_ENG" 255)
       ("CUI" "MRXNW_ENG") ("NWD" "MRXNW_ENG") ("WD" "MRXW_ENG")
       ("KCUISUI" "MRCONSO") ("KCUILUI" "MRCONSO")
       ("KCUILRL" "MRCONSO") ("KLUILRL" "MRCONSO") ("KSUILRL" "MRCONSO")

diff --git a/sql-classes.lisp b/sql-classes.lisp
index 9722be4f830a388f4bb93f694f9412cf07d4bfe0..8031ace4553584dfdf6f2e3411881cdae0f41bd8 100644 (file)
--- 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)