From: Kevin M. Rosenberg Date: Sun, 30 May 2004 07:28:33 +0000 (+0000) Subject: r9521: rrf updates X-Git-Tag: v2006ac.2~88 X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=commitdiff_plain;h=62ce365967f05ec6a2945a20cd5c45efb7b809e5 r9521: rrf updates --- diff --git a/classes.lisp b/classes.lisp index 7c3b9a8..e62c1ee 100644 --- a/classes.lisp +++ b/classes.lisp @@ -89,15 +89,6 @@ rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc curver sabin)) -(defclass uso (umlsclass) - ((sab :value-type string :initarg :sab :reader sab :hyperlink find-usab-rsab) - (code :value-type string :initarg :code :reader code) - (tty :value-type string :initarg :tty :reader tty :hyperlink find-btty-tty) - (srl :value-type fixnum :initarg :srl :reader srl)) - (:metaclass hyperobject-class) - (:user-name "Source") - (:default-print-slots sab code tty srl)) - (defclass ucxt (umlsclass) ((sab :value-type string :initarg :sab :reader sab :hyperlink find-usab-rsab) (code :value-type string :initarg :code :reader code) @@ -125,13 +116,30 @@ (str :value-type cdata :initarg :str :reader str) (lrl :value-type fixnum :initarg :lrl :reader lrl) (stt :value-type string :initarg :stt :reader stt) - (s#so :reader s#so :subobject (find-uso-cuisui cui sui)) + (s#so :reader s#atom :subobject (find-uso-cuisui cui sui)) (s#sat :reader s#sat :subobject (find-usat-ui cui lui sui)) (s#cxt :reader s#cxt :subobject (find-ucxt-cuisui cui sui))) (:metaclass hyperobject-class) (:user-name "String") (:default-print-slots sui stt lrl str)) +(defclass uso (umlsclass) + ((aui :value-type fixnum :initarg :aui :reader aui :print-formatter fmt-aui) + (cui :value-type fixnum :initarg :cui :reader cui :print-formatter fmt-cui + :hyperlink find-ucon-cui) + (sui :value-type fixnum :initarg :cui :reader sui :print-formatter fmt-sui + :hyperlink find-ucon-sui) + (saui :value-type string :initarg :saui :reader saui) + (sdui :value-type string :initarg :sdui :reader sdui) + (scui :value-type string :initarg :scui :reader scui) + (tty :value-type string :initarg :tty :reader tty :hyperlink find-btty-tty) + (sab :value-type string :initarg :sab :reader sab :hyperlink find-usab-rsab) + (code :value-type string :initarg :code :reader code) + (srl :value-type fixnum :initarg :srl :reader srl)) + (:metaclass hyperobject-class) + (:user-name "Source") + (:default-print-slots aui sab code saui adui scui tty srl)) + (defclass ulo (umlsclass) ((isn :value-type string :initarg :isn :reader isn) (fr :value-type fixnum :initarg :fr :reader fr) @@ -194,14 +202,6 @@ (:default-print-slots soc cot cof coa cui2 pfstr2)) -(defclass uatx (umlsclass) - ((sab :value-type string :initarg :sab :reader sab) - (rel :value-type string :initarg :rel :reader rel) - (atx :value-type cdata :initarg :atx :reader atx)) - (:metaclass hyperobject-class) - (:user-name "Associated Expression") - (:default-print-slots sab rel atx)) - (defclass ucon (umlsclass) ((cui :value-type fixnum :initarg :cui :reader cui :print-formatter fmt-cui :hyperlink find-ucon-cui) @@ -209,7 +209,6 @@ (pfstr :value-type cdata :initarg :pfstr :reader pfstr) (s#def :reader s#def :subobject (find-udef-cui cui)) (s#sty :reader s#sty :subobject (find-usty-cui cui)) - (s#atx :reader s#atx :subobject (find-uatx-cui cui)) (s#lo :reader s#lo :subobject (find-ulo-cui cui)) (s#term :reader s#term :subobject (find-uterm-cui cui)) (s#sat :reader s#sat :subobject (find-usat-ui cui)) diff --git a/create-sql.lisp b/create-sql.lisp index 4978843..3b8b39c 100644 --- a/create-sql.lisp +++ b/create-sql.lisp @@ -38,8 +38,13 @@ (string-equal sqltype "CHAR")) (format nil "~a (~a)" sqltype (cmax c)) sqltype)))))) - (format nil "CREATE TABLE ~a (~{~a~^,~})" (table file) - (mapcar col-func (ucols file))))) + (format nil "CREATE TABLE ~a (~{~a~^,~})~A" + (table file) + (mapcar col-func (ucols file)) + (if (and (eq *umls-sql-type* :mysql) + (string-equal (table file) "MRCXT")) + " MAX_ROWS=200000000" + "")))) (defun create-custom-table-cmd (tablename sql-cmd) "Return SQL command to create a custom table" @@ -144,8 +149,36 @@ (dolist (file *umls-files*) (sql-execute (create-table-cmd file) conn))) +#+ignore +(defun sql-create-kcon-table (conn) + "Create concept table, one row per concept." + (ignore-errors (execute-command "DROP TABLE KCON" :database conn)) + (execute-command + (format nil "CREATE TABLE KCON (CUI INTEGER, STR ~A, LRL ~A)" + (case *umls-sql-type* + (:oracle + (format nil "VARCHAR2(~D)" + (slot-value (find-ucol "STR" "MRCONSO.RRF") 'max))) + (t "TEXT")) + (case *umls-sql-type* + (:mysql "TINYINT") + ((:postgresql :postgresql-socket) "INT2") + (:oracle "NUMBER(2,0)") + (t "INTEGER"))) + :database conn) + (dolist (tuple (query "select distinct cui from MRCONSO order by cui" + :database conn)) + (let ((cui (car tuple))) + (execute-command + (format nil "INSERT into KCON VALUES (~D,'~A',~D)" + cui + (add-sql-quotes (pfstr-hash cui) ) + (cui-lrl cui)) + :database conn)))) + (defun sql-create-custom-tables (conn) "SQL Databases: create all custom tables" + ;;(sql-create-kcon-table conn) (dolist (ct +custom-tables+) (sql-execute (create-custom-table-cmd (car ct) (cadr ct)) conn))) @@ -270,7 +303,7 @@ This is much faster that using create-umls-db-insert." "Return postgresql copy statement for a file" (format nil "COPY ~a FROM '~a' using delimiters '|' with null as ''" - (table file) (umls-pathname (fil file) extension))) + (table file) (ufile-pathname file extension))) (defun mysql-copy-cmd (file extension &key local-file) "Return mysql copy statement for a file" @@ -278,7 +311,7 @@ This is much faster that using create-umls-db-insert." nil "LOAD DATA ~AINFILE \"~a\" INTO TABLE ~a FIELDS TERMINATED BY \"|\"" (if local-file "LOCAL " "") - (umls-pathname (fil file) extension) (table file))) + (ufile-pathname file extension) (table file))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/package.lisp b/package.lisp index dedcb07..072d97e 100644 --- a/package.lisp +++ b/package.lisp @@ -28,7 +28,7 @@ ;; From classes.lisp #1=(#:umlsclass #:ucon #:uterm #:ustr #:usrl #:uso #:ucxt #:urank #:udef #:usat #:usab #:ulo - #:urel #:ucoc #:usty #:uatx #:uxw #:uxnw #:uxns + #:urel #:ucoc #:usty #:uxw #:uxnw #:uxns #:lexterm #:labr #:lagr #:lcmp #:lmod #:lnom #:lprn #:lprp #:lspl #:ltrm #:ltyp #:lwd #:sdef #:sstr #:sstre1 #:sstre2 #:sty #:tui #:def #:sab #:srl #:tty #:rank #:supres #:atn #:atv #:vcui @@ -36,7 +36,7 @@ #:rl #:sty2 #:ui #:ui2 #:ui3 #:eui #:bas #:eui2 #:bas2 #:cui #:lui #:sui #:wd #:lat #:nstr :cuilist #:rsab #:lat - #:s#def #:s#sty #:s#term #:s#str #:s#atx #:s#lo #:s#sat #:s#rel #:s#coc + #:s#def #:s#sty #:s#term #:s#str #:s#lo #:s#sat #:s#rel #:s#coc #:s#so #:s#cxt #:pfstr #:pfstr2 #:lrl #:def #:ts #:cui1 #:cui2 #:rela #:sl #:mg #:rel #:soc #:cot #:cof #:coa #:isn #:fr #:un #:sna #:soui #:hcd #:stt #:str @@ -93,7 +93,6 @@ #:find-usty-sty #:find-ulo-cui #:suistr - #:find-uatx-cui #:print-umlsclass #:find-ucon-cui #:find-ucon-cui-sans-pfstr diff --git a/parse-common.lisp b/parse-common.lisp index c603236..e2cb6ea 100644 --- a/parse-common.lisp +++ b/parse-common.lisp @@ -206,7 +206,10 @@ Currently, these are the LEX and NET files." (defun find-ucols-for-ufile (ufile) "Returns list of umls-cols for a file structure" (loop for colname in (fields ufile) - collect (find-ucol colname (fil ufile)))) + collect (find-ucol colname + (if (subdir ufile) + (concatenate 'string (subdir ufile) "/" (fil ufile)) + (fil ufile))))) (defun umls-field-string-to-list (fmt) "Converts a comma delimited list of fields into a list of field names. Will @@ -250,32 +253,73 @@ append a unique number (starting at 2) onto a column name that is repeated in th "Return datatype for column name" (second (find colname +col-datatypes+ :key #'car :test #'string-equal))) +(defun canonicalize-column-type (type) + (cond + ((string-equal type "SMALLINT") + (case *umls-sql-type* + (:mysql "SMALLINT") + ((:postgresql :postgresql-socket) "INT2") + (:oracle "NUMBER(5,0)") + (t "INTEGER"))) + ((string-equal type "INTEGER") + (case *umls-sql-type* + (:mysql "INTEGER") + ((:postgresql :postgresql-socket) "INT4") + (:oracle "NUMBER(9,0)") + (t "INTEGER"))) + ((string-equal type "BIGINT") + (case *umls-sql-type* + (:mysql "BIGINT") + ((:postgresql :postgresql-socket) "INT8") + (:oracle "NUMBER(38,0)") + (t "INTEGER"))) + ((string-equal type "TEXT") + (case *umls-sql-type* + (:mysql "TEXT") + ((:postgresql :postgresql-socket) "TEXT") + (:oracle "VARCHAR2(3000)") + (t "VARCHAR(3000)"))) + ((string-equal type "VARCHAR") + (case *umls-sql-type* + (:mysql "VARCHAR") + ((:postgresql :postgresql-socket) "VARCHAR") + (:oracle "VARCHAR2") + (t "VARCHAR"))) + ((string-equal type "NUMERIC") + (case *umls-sql-type* + (:mysql "NUMERIC") + ((:postgresql :postgresql-socket) "NUMERIC") + (:oracle "NUMBER") + (t "NUMERIC"))) + (t + type))) + (defun ensure-ucol-datatype (col datatype) -"Add data type information to column" + "Add data type information to column" (setf (datatype col) datatype) (case datatype - (sql-u (setf (sqltype col) "INTEGER" + (sql-u (setf (sqltype col) (canonicalize-column-type "INTEGER") (parse-fun col) #'parse-ui (quote-str col) "")) - (sql-s (setf (sqltype col) "SMALLINT" + (sql-s (setf (sqltype col) (canonicalize-column-type "SMALLINT") (parse-fun col) #'parse-integer (quote-str col) "")) - (sql-l (setf (sqltype col) "BIGINT" + (sql-l (setf (sqltype col) (canonicalize-column-type "BIGINT") (parse-fun col) #'parse-integer (quote-str col) "")) - (sql-i (setf (sqltype col) "INTEGER" + (sql-i (setf (sqltype col) (canonicalize-column-type "INTEGER") (parse-fun col) #'parse-integer (quote-str col) "")) - (sql-f (setf (sqltype col) "NUMERIC" + (sql-f (setf (sqltype col) (canonicalize-column-type "NUMERIC") (parse-fun col) #'read-from-string (quote-str col) "")) - (t ; Default column type, optimized text storage + (t ; Default column type, optimized text storage (setf (parse-fun col) #'add-sql-quotes (quote-str col) "'") (when (and (cmax col) (av col)) (if (> (cmax col) 255) - (setf (sqltype col) "TEXT") - (setf (sqltype col) "VARCHAR")))))) + (setf (sqltype col) (canonicalize-column-type "TEXT")) + (setf (sqltype col) (canonicalize-column-type "VARCHAR"))))))) (defun escape-column-name (name) (substitute #\_ #\/ name)) diff --git a/parse-rrf.lisp b/parse-rrf.lisp index 8b13b3a..793f81c 100644 --- a/parse-rrf.lisp +++ b/parse-rrf.lisp @@ -23,24 +23,27 @@ (defvar *preparse-hash-init?* nil) (eval-when (:compile-toplevel :load-toplevel :execute) -(let ((pfstr-hash nil) ;;; Preferred concept strings by CUI - (cui-lrl-hash nil) ;;; LRL by CUI - (lui-lrl-hash nil) ;;; LRL by LUI - (cuisui-lrl-hash nil) ;;; LRL by CUISUI - (sab-srl-hash nil)) ;;; SRL by SAB +(let ((pfstr-hash nil) ;; Preferred concept strings by CUI + (cui-lrl-hash nil) ;; LRL by CUI + (lui-lrl-hash nil) ;; LRL by LUI + (sui-lrl-hash nil) ;; LRL by SUI + (cuisui-lrl-hash nil) ;; LRL by CUISUI + (sab-srl-hash nil)) ;; SRL by SAB (defun make-preparse-hash-table () - (if pfstr-hash + (if sui-lrl-hash (progn (clrhash pfstr-hash) (clrhash cui-lrl-hash) (clrhash lui-lrl-hash) + (clrhash sui-lrl-hash) (clrhash cuisui-lrl-hash) (clrhash sab-srl-hash)) (setf pfstr-hash (make-hash-table :size 800000) cui-lrl-hash (make-hash-table :size 800000) lui-lrl-hash (make-hash-table :size 1500000) + sui-lrl-hash (make-hash-table :size 1500000) cuisui-lrl-hash (make-hash-table :size 1800000) sab-srl-hash (make-hash-table :size 100 :test 'equal)))) @@ -61,26 +64,20 @@ (setf (gethash cui pfstr-hash) (nth 14 line)))) (set-lrl-hash cui srl cui-lrl-hash) (set-lrl-hash lui srl lui-lrl-hash) + (set-lrl-hash sui srl sui-lrl-hash) (set-lrl-hash (make-cuisui cui sui) srl cuisui-lrl-hash) (multiple-value-bind (val found) (gethash sab sab-srl-hash) (declare (ignore val)) (unless found (setf (gethash sab sab-srl-hash) srl)))))) - (defun pfstr-hash (cui) - (gethash cui pfstr-hash)) + (defun pfstr-hash (cui) (gethash cui pfstr-hash)) + (defun cui-lrl (cui) (gethash cui cui-lrl-hash)) + (defun lui-lrl (lui) (gethash lui lui-lrl-hash)) + (defun sui-lrl (sui) (gethash sui sui-lrl-hash)) + (defun sab-srl (sab) (aif (gethash sab sab-srl-hash) it 0)) + (defun cuisui-lrl (cuisui) (gethash cuisui cuisui-lrl-hash)) - (defun cui-lrl (cui) - (gethash cui cui-lrl-hash)) - - (defun lui-lrl (lui) - (gethash lui lui-lrl-hash)) - - (defun cuisui-lrl (cuisui) - (gethash cuisui cuisui-lrl-hash)) - - (defun sab-srl (sab) - (aif (gethash sab sab-srl-hash) it 0)) )) ;; closure (defun set-lrl-hash (key lrl hash) @@ -100,7 +97,8 @@ (defparameter +col-datatypes+ '(("AV" sql-f) ("BTS" sql-i) ("CLS" sql-i) ("COF" sql-i) ("CUI1" sql-u) - ("AUI" sql-u) ("AUI1" sql-u) ("AUI2" sql-u) + ("AUI" sql-u) ("AUI1" sql-u) ("AUI2" sql-u) ("PCUI" sql-u) + ("PLUI" sql-u) ("CUI2" sql-u) ("CUI" sql-u) ("CXN" sql-s) ("FR" sql-i) ("LRL" sql-s) ("LUI" sql-u) ("MAX" sql-s) ("MIN" sql-s) ("RANK" sql-s) ("REF" sql-c) ("RNK" sql-s) ("RWS" sql-i) ("SRL" sql-s) ("SUI" sql-u) ("TUI" sql-u) @@ -113,62 +111,66 @@ ("UI" sql-u) ("UI2" sql-u) ("UI3" sql-u) ;; New fields for 2002AD ("RCUI" sql-u) ("VCUI" sql-u) ("CFR" sql-i) ("TFR" sql-i) + ("MAPSETCUI" sql-u) ) "SQL data types for each non-string column") (defparameter +custom-tables+ nil + #+ignore + '(("KCON" "SELECT CUI,STR FROM MRCONSO WHERE STT='PF' AND TS='P' AND ISPREF='Y' AND LAT='ENG'")) "Custom tables to create") (defparameter +custom-cols+ - '(("MRCONSO.RRF" "KPFSTR" "TEXT" 1024 - (lambda (x) (pfstr-hash (parse-ui (nth 0 x))))) + '(("MRCONSO.RRF" "KPFSTR" "TEXT" + (slot-value (find-ucol "STR" "MRCONSO.RRF") 'max) + (lambda (x) (pfstr-hash (parse-ui (nth 0 x))))) ("MRCONSO.RRF" "KCUISUI" "BIGINT" 0 (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 5 x)))))) ("MRCONSO.RRF" "KCUILUI" "BIGINT" 0 (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 3 x)))))) - ("MRCONSO.RRF" "KCUILRL" "INTEGER" 0 - (lambda (x) (write-to-string (cui-lrl (parse-ui (nth 0 x)))))) - ("MRCONSO.RRF" "KLUILRL" "INTEGER" 0 + ("MRCONSO.RRF" "KCUILRL" "SMALLINT" 0 + (lambda (x) (write-to-string (lui-lrl (parse-ui (nth 0 x)))))) + ("MRCONSO.RRF" "KLUILRL" "SMALLINT" 0 (lambda (x) (write-to-string (lui-lrl (parse-ui (nth 3 x)))))) + ("MRCONSO.RRF" "KSUILRL" "SMALLINT" 0 + (lambda (x) (write-to-string (sui-lrl (parse-ui (nth 5 x)))))) ;; Deprecated, last in 2004AA -- skip index #+ignore - ("MRLO.RRF" "KLRL" "INTEGER" 0 + ("MRLO.RRF" "KLRL" "SMALLINT" 0 (lambda (x) (write-to-string (if (zerop (length (nth 4 x))) (cui-lrl (parse-ui (nth 0 x))) (cuisui-lrl (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 4 x)))))))) - ("MRSTY.RRF" "KLRL" "INTEGER" 0 + ("MRSTY.RRF" "KLRL" "SMALLINT" 0 (lambda (x) (write-to-string (cui-lrl (parse-ui (nth 0 x)))))) - ("MRCOC.RRF" "KLRL" "INTEGER" 0 + ("MRCOC.RRF" "KLRL" "SMALLINT" 0 (lambda (x) (write-to-string (max (cui-lrl (parse-ui (nth 0 x))) (kmrcl:aif (cui-lrl (parse-ui (nth 1 x))) kmrcl::it 0))))) - ("MRSAT.RRF" "KSRL" "INTEGER" 0 + ("MRSAT.RRF" "KSRL" "SMALLINT" 0 (lambda (x) (write-to-string (sab-srl (nth 9 x))))) - ("MRREL.RRF" "KSRL" "INTEGER" 0 + ("MRREL.RRF" "KSRL" "SMALLINT" 0 (lambda (x) (write-to-string (sab-srl (nth 10 x))))) - ("MRRANK.RRF" "KSRL" "INTEGER" 0 + ("MRRANK.RRF" "KSRL" "SMALLINT" 0 (lambda (x) (write-to-string (sab-srl (nth 1 x))))) - ("MRDEF.RRF" "KSRL" "INTEGER" 0 + ("MRDEF.RRF" "KSRL" "SMALLINT" 0 (lambda (x) (write-to-string (sab-srl (nth 4 x))))) - ("MRCXT.RRF" "KSRL" "INTEGER" 0 + ("MRCXT.RRF" "KSRL" "SMALLINT" 0 (lambda (x) (write-to-string (sab-srl (nth 2 x))))) - ("MRATX.RRF" "KSRL" "INTEGER" 0 - (lambda (x) (write-to-string (sab-srl (nth 1 x))))) - ("MRXW_ENG.RRF" "KLRL" "INTEGER" 0 + ("MRXW_ENG.RRF" "KLRL" "SMALLINT" 0 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))) - ("MRXW_NONENG.RRF" "KLRL" "INTEGER" 0 + ("MRXW_NONENG.RRF" "KLRL" "SMALLINT" 0 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))) - ("MRXNW_ENG.RRF" "KLRL" "INTEGER" 0 + ("MRXNW_ENG.RRF" "KLRL" "SMALLINT" 0 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))) - ("MRXNS_ENG.RRF" "KLRL" "INTEGER" 0 + ("MRXNS_ENG.RRF" "KLRL" "SMALLINT" 0 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))) @@ -198,7 +200,7 @@ "Custom columns to create.(filename, col, sqltype, value-func).") (defparameter +index-cols+ - '(("CUI" "MRATX") ("CUI1" "MRCOC") ("CUI" "MRCONSO") ("LUI" "MRCONSO") + '(("CUI1" "MRCOC") ("CUI" "MRCONSO") ("LUI" "MRCONSO") ("SRL" "MRCONSO") ("AUI" "MRCONSO") ("SUI" "MRCONSO") ("CUI" "MRCXT") ("CUI" "MRDEF") ("CUI" "MRLO") ("CUI1" "MRREL") ("CUI" "MRSAT") ("LUI" "MRSAT") ("SUI" "MRSAT") @@ -206,12 +208,12 @@ ("TUI" "MRSTY") ("CUI" "MRXNS_ENG") #+ignore ("NSTR" "MRXNS_ENG" 10) ("CUI" "MRXNW_ENG") ("NWD" "MRXNW_ENG") ("WD" "MRXW_ENG") - ("KCUISUI" "MRCON") ("KCUILUI" "MRCON") ("KCUILRL" "MRCON") - ("KLUILRL" "MRCON") ("KCUISUI" "MRCXT") - ("KCUISUI" "MRSO") ("KCUISUI" "MRSAT") ("KCUILUI" "MRSAT") + ("KCUISUI" "MRCONSO") ("KCUILUI" "MRCONSO") ("KCUILRL" "MRCONSO") + ("KLUILRL" "MRCONSO") ("KCUISUI" "MRCXT") + ("KCUISUI" "MRSAT") ("KCUILUI" "MRSAT") ("KCUISUI" "MRXW_ENG") ("KCUISUI" "MRXNW_ENG") ("KCUISUI" "MRXNS_ENG") ("KCUISUI" "MRXW_NONENG") - ("KSRL" "MRATX") ("KSRL" "MRCXT") ("KSRL" "MRDEF") ("KSRL" "MRRANK") + ("KSRL" "MRCXT") ("KSRL" "MRDEF") ("KSRL" "MRRANK") ("KSRL" "MRREL") ("KSRL" "MRSAT") ("KLRL" "MRCOC") #+ignore ("KLRL" "MRLO") ;; deprecated ("KLRL" "MRSTY") ("KLRL" "MRXW_ENG") ("KLRL" "MRXNW_ENG") @@ -233,7 +235,7 @@ (defparameter +custom-index-cols+ nil #+ignore - '(("CUI" "MRCONFULL") ("SAB" "MRCONFULL") ("TUI" "MRCONFULL")) + '(("CUI" "KCON") ("LRL" "KCON")) "Indexes to custom tables") ;; File & Column functions @@ -258,8 +260,8 @@ "Initialize umls columns for custom columns" (loop for customcol in +custom-cols+ collect - (make-ucol (nth 1 customcol) "" 0 0 0 (nth 3 customcol) - (nth 0 customcol) nil :sqltype (nth 2 customcol) + (make-ucol (nth 1 customcol) "" 0 0 0 (eval (nth 3 customcol)) + (nth 0 customcol) nil :sqltype (canonicalize-column-type (nth 2 customcol)) :custom-value-fun (nth 4 customcol)))) (defun gen-ucols-generic (col-filename) diff --git a/sql-classes.lisp b/sql-classes.lisp index a7b0804..550cb2c 100644 --- a/sql-classes.lisp +++ b/sql-classes.lisp @@ -187,27 +187,28 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-ucon-cui (cui &key (srl *current-srl*)) "Find ucon for a cui" (ensure-cui-integer cui) - (collect-umlisp-query (mrcon (kpfstr kcuilrl) srl cui cui :single t) + (collect-umlisp-query (mrconso (kpfstr kcuilrl) srl cui cui :single t) (make-instance 'ucon :cui cui :pfstr kpfstr :lrl (ensure-integer kcuilrl)))) (defun find-ucon-cui-sans-pfstr (cui &key (srl *current-srl*)) "Find ucon for a cui" (ensure-cui-integer cui) - (collect-umlisp-query (mrcon (kcuilrl) srl cui cui :single t) + (collect-umlisp-query (mrconso (kcuilrl) srl cui cui :single t) (make-instance 'ucon :cui cui :lrl (ensure-integer kcuilrl) :pfstr nil))) (defun find-pfstr-cui (cui &key (srl *current-srl*)) "Find preferred string for a cui" (ensure-cui-integer cui) - (collect-umlisp-query (mrcon (kpfstr) srl cui cui :single t) + (collect-umlisp-query (mrconso (kpfstr) srl cui cui :single t) kpfstr)) + (defun find-ucon-lui (lui &key (srl *current-srl*)) "Find list of ucon for lui" (ensure-lui-integer lui) - (collect-umlisp-query (mrcon (cui kpfstr kcuilrl) srl lui lui + (collect-umlisp-query (mrconso (cui kpfstr kcuilrl) srl lui lui :distinct t) (make-instance 'ucon :cui (ensure-integer cui) :pfstr kpfstr :lrl (ensure-integer kcuilrl)))) @@ -215,7 +216,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-ucon-sui (sui &key (srl *current-srl*)) "Find list of ucon for sui" (ensure-sui-integer sui) - (collect-umlisp-query (mrcon (cui kpfstr kcuilrl) srl sui sui :distinct t) + (collect-umlisp-query (mrconso (cui kpfstr kcuilrl) srl sui sui :distinct t) (make-instance 'ucon :cui (ensure-integer cui) :pfstr kpfstr :lrl (ensure-integer kcuilrl)))) @@ -224,7 +225,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (ensure-cui-integer cui) (ensure-sui-integer sui) (when (and cui sui) - (collect-umlisp-query (mrcon (kpfstr kcuilrl) srl kcuisui + (collect-umlisp-query (mrconso (kpfstr kcuilrl) srl kcuisui (make-cuisui cui sui)) (make-instance 'ucon :cui cui :pfstr kpfstr @@ -232,7 +233,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-ucon-str (str &key (srl *current-srl*)) "Find ucon that are exact match for str" - (collect-umlisp-query (mrcon (cui kpfstr kcuilrl) srl str str :distinct t) + (collect-umlisp-query (mrconso (cui kpfstr kcuilrl) srl str str :distinct t) (make-instance 'ucon :cui (ensure-integer cui) :pfstr kpfstr :lrl (ensure-integer kcuilrl)))) @@ -241,17 +242,18 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (with-sql-connection (db) (clsql:map-query 'list - #'(lambda (cui pfstr cuilrl) - (make-instance 'ucon :cui (ensure-integer cui) - :pfstr pfstr - :lrl (ensure-integer cuilrl))) - (query-string mrcon (cui kpfstr kcuilrl) srl nil nil + #'(lambda (tuple) + (destructuring-bind (cui pfstr cuilrl) tuple + (make-instance 'ucon :cui (ensure-integer cui) + :pfstr pfstr + :lrl (ensure-integer cuilrl)))) + (query-string mrconso (cui kpfstr kcuilrl) srl nil nil :order (cui asc) :distinct t) :database db))) (defun find-ucon-all2 (&key (srl *current-srl*)) "Return list of all ucon's" - (collect-umlisp-query (mrcon (cui kpfstr kcuilrl) srl nil nil :order (cui asc) + (collect-umlisp-query (mrconso (cui kpfstr kcuilrl) srl nil nil :order (cui asc) :distinct t) (make-instance 'ucon :cui (ensure-integer cui) :pfstr kpfstr @@ -259,7 +261,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-cui-ucon-all (&key (srl *current-srl*)) "Return list of CUIs for all ucons" - (collect-umlisp-query (mrcon (cui) srl nil nil :order (cui asc) + (collect-umlisp-query (mrconso (cui) srl nil nil :order (cui asc) :distinct t) cui)) @@ -268,12 +270,12 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (with-sql-connection (db) (clsql:map-query nil - #'(lambda (cui pfstr cuilrl) - (funcall fn - (make-instance 'ucon :cui (ensure-integer cui) - :pfstr pfstr - :lrl (ensure-integer cuilrl)))) - (query-string mrcon (cui kpfstr kcuilrl) srl nil nil :order (cui asc) + #'(lambda (tuple) + (destructuring-bind (cui pfstr cuilrl) tuple + (funcall fn (make-instance 'ucon :cui (ensure-integer cui) + :pfstr pfstr + :lrl (ensure-integer cuilrl))))) + (query-string mrconso (cui kpfstr kcuilrl) srl nil nil :order (cui asc) :distinct t) :database db))) @@ -363,17 +365,11 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (make-instance 'ulo :isn isn :fr (ensure-integer fr) :un un :sui (ensure-integer sui) :sna sna :soui soui))) -(defun find-uatx-cui (cui &key (srl *current-srl*)) - "Return a list of uatx for cui" - (ensure-cui-integer cui) - (collect-umlisp-query (mratx (sab rel atx) srl cui cui :lrl ksrl) - (make-instance 'uatx :sab sab :rel rel :atx atx))) - (defun find-uterm-cui (cui &key (srl *current-srl*)) "Return a list of uterm for cui" (ensure-cui-integer cui) - (collect-umlisp-query (mrcon (lui lat ts kluilrl) srl cui cui + (collect-umlisp-query (mrconso (lui lat ts kluilrl) srl cui cui :lrl kluilrl :distinct t) (make-instance 'uterm :lui (ensure-integer lui) :cui cui :lat lat :ts ts :lrl (ensure-integer kluilrl)))) @@ -381,7 +377,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-uterm-lui (lui &key (srl *current-srl*)) "Return a list of uterm for lui" (ensure-lui-integer lui) - (collect-umlisp-query (mrcon (cui lat ts kluilrl) srl lui lui + (collect-umlisp-query (mrconso (cui lat ts kluilrl) srl lui lui :lrl kluilrl :distinct t) (make-instance 'uterm :cui (ensure-integer cui) :lui lui :lat lat :ts ts :lrl (ensure-integer kluilrl)))) @@ -390,7 +386,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" "Return single uterm for cui/lui" (ensure-cui-integer cui) (ensure-lui-integer lui) - (collect-umlisp-query (mrcon (lat ts kluilrl) srl kcuilui + (collect-umlisp-query (mrconso (lat ts kluilrl) srl kcuilui (make-cuilui cui lui) :lrl kluilrl :single t) (make-instance 'uterm :cui cui :lui lui :lat lat :ts ts @@ -400,34 +396,34 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" "Return a list of ustr for cui/lui" (ensure-cui-integer cui) (ensure-lui-integer lui) - (collect-umlisp-query (mrcon (sui stt str lrl) srl kcuilui - (make-cuilui cui lui) :lrl lrl) - (make-instance 'ustr :sui (ensure-integer sui) :cui cui :lui lui + (collect-umlisp-query (mrconso (sui stt str ksuilrl) srl kcuilui + (make-cuilui cui lui) :lrl ksuilrl) + (make-instance 'ustr :sui (ensure-integer sui) :cui cui :lui lui :cuisui (make-cuisui cui sui) :stt stt :str str - :lrl (ensure-integer lrl)))) + :lrl (ensure-integer ksuilrl)))) (defun find-ustr-cuisui (cui sui &key (srl *current-srl*)) "Return the single ustr for cuisui" (ensure-cui-integer cui) (ensure-sui-integer sui) - (collect-umlisp-query (mrcon (lui stt str lrl) srl kcuisui - (make-cuisui cui sui) :lrl lrl :single t) + (collect-umlisp-query (mrconso (lui stt str ksuilrl) srl kcuisui + (make-cuisui cui sui) :lrl lsuilrl :single t) (make-instance 'ustr :sui sui :cui cui :cuisui (make-cuisui cui sui) :lui (ensure-integer lui) :stt stt :str str - :lrl (ensure-integer lrl)))) + :lrl (ensure-integer ksuilrl)))) (defun find-ustr-sui (sui &key (srl *current-srl*)) "Return the list of ustr for sui" (ensure-sui-integer sui) - (collect-umlisp-query (mrcon (cui lui stt str lrl) srl sui sui - :lrl lrl) + (collect-umlisp-query (mrconso (cui lui stt str ksuilrl) srl sui sui + :lrl ksuilrl) (make-instance 'ustr :sui sui :cui cui :stt stt :str str :cuisui (make-cuisui (ensure-integer cui) sui) - :lui (ensure-integer lui) :lrl (ensure-integer lrl)))) + :lui (ensure-integer lui) :lrl (ensure-integer ksuilrl)))) (defun find-ustr-sab (sab &key (srl *current-srl*)) "Return the list of ustr for sab" - (collect-umlisp-query (mrso (kcuisui) srl sab sab :lrl srl) + (collect-umlisp-query (mrconso (kcuisui) srl sab sab :lrl srl) (let ((cuisui (ensure-integer kcuisui))) (apply #'find-ustr-cuisui (append @@ -439,14 +435,15 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (with-sql-connection (db) (clsql:map-query 'list - #'(lambda (cui lui sui stt lrl pfstr) - (make-instance 'ustr :cui (ensure-integer cui) - :lui (ensure-integer lui) :sui (ensure-integer sui) - :stt stt :str pfstr - :cuisui (make-cuisui (ensure-integer cui) - (ensure-integer sui)) - :lrl (ensure-integer lrl))) - (query-string mrcon (cui lui sui stt lrl kpfstr) srl nil nil :lrl lrl + #'(lambda (tuple) + (destructuring-bind (cui lui sui stt ksuilrl pfstr) tuple + (make-instance 'ustr :cui (ensure-integer cui) + :lui (ensure-integer lui) :sui (ensure-integer sui) + :stt stt :str pfstr + :cuisui (make-cuisui (ensure-integer cui) + (ensure-integer sui)) + :lrl (ensure-integer ksuilrl)))) + (query-string mrconso (cui lui sui stt ksuilrl kpfstr) srl nil nil :lrl ksuilrl :distinct t :order (sui asc)) :database db))) @@ -454,15 +451,23 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-string-sui (sui &key (srl *current-srl*)) "Return the string associated with sui" (ensure-sui-integer sui) - (collect-umlisp-query (mrcon (str) srl sui sui :lrl lrl :single t) + (collect-umlisp-query (mrconso (str) srl sui sui :lrl ksuilrl :single t) str)) (defun find-uso-cuisui (cui sui &key (srl *current-srl*)) (ensure-sui-integer sui) (ensure-cui-integer cui) - (collect-umlisp-query (mrso (sab code srl tty) srl kcuisui + (collect-umlisp-query (mrconso (aui sab code srl tty saui sdui scui) srl kcuisui (make-cuisui cui sui) :lrl srl) - (make-instance 'uso :sab sab :code code :srl srl :tty tty))) + (make-instance 'uso :aui aui :sab sab :code code :srl srl :tty tty + :cui cui :sui sui :saui saui :sdui sdui :scui scui))) + +(defun find-uso-aui (aui &key (srl *current-srl*)) + (ensure-sui-integer aui) + (collect-umlisp-query (mrconso (sab cui sui code srl tty saui sdui scui) srl aui + aui :lrl srl :single t) + (make-instance 'uso :aui aui :cui cui :sab sab :code code :srl srl :tty tty + :sui sui :saui saui :sdui sdui :scui scui))) (defun find-ucxt-cuisui (cui sui &key (srl *current-srl*)) (ensure-cui-integer cui) @@ -796,12 +801,11 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (sql-execute "create table USTATS (NAME varchar(160), COUNT bigint, SRL integer)" conn) (dotimes (srl 4) - (insert-ustats-count conn "Concept Count" "MRCON" "distinct CUI" "KCUILRL" srl) - (insert-ustats-count conn "Term Count" "MRCON" "distinct KCUILUI" "KCUILRL" srl) - (insert-ustats-count conn "Distinct Term Count" "MRCON" "distinct LUI" "KLUILRL" srl) - (insert-ustats-count conn "String Count" "MRCON" "*" "LRL" srl) - (insert-ustats-count conn "Distinct String Count" "MRCON" "distinct SUI" "LRL" srl) - (insert-ustats-count conn "Associated Expression Count" "MRATX" "*" "KSRL" srl) + (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" "*" "LRL" srl) + (insert-ustats-count conn "Distinct String Count" "MRCONSO" "distinct SUI" "LRL" srl) (insert-ustats-count conn "Context Count" "MRCXT" "*" "KSRL" srl) (insert-ustats-count conn "Co-occuring Concept Count" "MRCOC" "*" "KLRL" srl) (insert-ustats-count conn "Definition Count" "MRDEF" "*" "KSRL" srl)