From: Kevin M. Rosenberg Date: Fri, 12 Mar 2010 18:29:39 +0000 (-0700) Subject: Add mysql utf8 collation, new lookup functions X-Git-Tag: debian-2007ac.2-6~6 X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=commitdiff_plain;h=5f22946ec144f413cd4306bc60daad9658fced72 Add mysql utf8 collation, new lookup functions --- diff --git a/create-sql.lisp b/create-sql.lisp index 88fa898..544267c 100644 --- 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 9572374..e8b4b4f 100644 --- 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 efb8975..3b02c7f 100644 --- 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 9722be4..8031ace 100644 --- 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)