From: Kevin M. Rosenberg Date: Sat, 14 Mar 2015 19:02:48 +0000 (-0600) Subject: Update to UMLS 2014AB. Main change is removal of MRCOC. X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=commitdiff_plain;h=ab8b9c83accebd43e817e1d5cee6a8f7fb9a7eab Update to UMLS 2014AB. Main change is removal of MRCOC. Make COC support based on umlisp::mrcoc in *features* --- diff --git a/class-support.lisp b/class-support.lisp index 0352c74..47463dd 100644 --- a/class-support.lisp +++ b/class-support.lisp @@ -291,6 +291,7 @@ (sort (copy-seq f) 'string-lessp :key 'u::pfstr2) f))) +#+mrcoc (defun filter-ucocs (ucocs &key (remove-duplicate-pfstr2 t) (sort :pfstr2)) (when remove-duplicate-pfstr2 (setq ucocs (remove-duplicates ucocs :test 'equal :key 'u::pfstr2))) @@ -364,6 +365,8 @@ #+scl -(dolist (c '(urank udef usat uso ucxt ustr uterm usty urel ucoc uatx uconso uxw uxnw uxns lexterm labr lagr lcmp lmod lnom lprn lprp lspl ltrm ltyp lwd sdef sstr sstre1 sstre2 usrl)) +(dolist (c '(urank udef usat uso ucxt ustr uterm usty urel + #+mrcoc ucoc + uatx uconso uxw uxnw uxns lexterm labr lagr lcmp lmod lnom lprn lprp lspl ltrm ltyp lwd sdef sstr sstre1 sstre2 usrl)) (let ((cl (find-class c))) (clos:finalize-inheritance cl))) diff --git a/classes.lisp b/classes.lisp index 05af0fb..1c65629 100644 --- a/classes.lisp +++ b/classes.lisp @@ -194,6 +194,7 @@ (:user-name "Relationship") (:default-print-slots stype1 rel cui2 aui2 stype2 rela rui srui sab sl rg dir suppress pfstr2)) +#+mrcoc (defclass ucoc (umlsclass) ((cui1 :value-type fixnum :initarg :cui1 :reader cui1 :print-formatter fmt-cui) (aui1 :value-type fixnum :initarg :aui1 :reader aui1 :print-formatter fmt-aui) @@ -227,7 +228,8 @@ (s#term :reader s#term :subobject (find-uterm-cui cui)) (s#sat :reader s#sat :subobject (find-usat-ui cui)) (s#rel :reader s#rel :subobject (find-urel-cui cui)) - (s#coc :reader s#coc :subobject (find-ucoc-cui cui))) + #+mrcoc (s#coc :reader s#coc :subobject (find-ucoc-cui cui)) + ) (:metaclass hyperobject-class) (:user-name "Concept") (:default-print-slots cui lrl pfstr)) @@ -270,7 +272,8 @@ (s#term :reader s#term :subobject (find-uterm-cui cui)) (s#sat :reader s#sat :subobject (find-usat-ui cui)) (s#rel :reader s#rel :subobject (find-urel-cui cui)) - (s#coc :reader s#coc :subobject (find-ucoc-cui cui))) + #+mrcoc (s#coc :reader s#coc :subobject (find-ucoc-cui cui)) + ) (:documentation "CONSO is a new concept from the RRF files.") (:metaclass hyperobject-class) (:user-name "Concept") diff --git a/composite.lisp b/composite.lisp index afd3e16..1c453e1 100644 --- a/composite.lisp +++ b/composite.lisp @@ -50,7 +50,7 @@ (funcall related-con-func ucon)) :key #'cui)) -(defun find-ucon2-coc-tui (ucon tui) +#+mrcoc (defun find-ucon2-coc-tui (ucon tui) "Return list of ucon's that have co-occuring concepts of semantic type tui" (find-ucon2-tui ucon tui #'cui2 #'s#coc)) @@ -124,7 +124,7 @@ freqs))) (sort freqs #'> :key #'freq))) -(defun find-ucon2_freq-coc-tui (ucon tui) +#+mrcoc (defun find-ucon2_freq-coc-tui (ucon tui) "Return sorted list of tuples with ucon and freq that have co-occuring concepts of semantic type tui" (let ((ucon_freqs '())) (dolist (ucoc (s#coc ucon)) @@ -145,7 +145,7 @@ (funcall lookup-func ucon (tui usty)) nil))) -(defun find-ucon2-coc-str&sty (str sty) +#+mrcoc (defun find-ucon2-coc-str&sty (str sty) "Find all ucons that are a co-occuring concept for concept named str and that have semantic type of sty" (find-ucon2-str&sty str sty #'find-ucon2-coc-tui)) @@ -178,7 +178,7 @@ "Sorted list of ucon_freq with semantic type tui that are rel's of ucons with semantic type tui" (find-ucon2_freq-tui-all tui #'find-ucon2-rel-tui)) -(defun find-ucon2_freq-coc-tui-all (tui) +#+mrcoc (defun find-ucon2_freq-coc-tui-all (tui) (find-ucon2_freq-tui-all tui #'find-ucon2-coc-tui)) #+(or scl) diff --git a/create-sql.lisp b/create-sql.lisp index 27f65de..20964f5 100644 --- a/create-sql.lisp +++ b/create-sql.lisp @@ -292,7 +292,7 @@ (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) +#+mrcoc (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) diff --git a/data-structures.lisp b/data-structures.lisp index 10e1c0c..d76a5c2 100644 --- a/data-structures.lisp +++ b/data-structures.lisp @@ -18,7 +18,7 @@ ;;; Paths for files -(defparameter *release* "2011AA") +(defparameter *release* "2014AB") (defparameter *umls-path* (make-pathname :directory (list :absolute "srv" "umls" *release* *release*)) @@ -111,5 +111,3 @@ (defmethod print-object ((obj ucol) s) (print-unreadable-object (obj s :type t) (format s "~A" (col obj)))) - - diff --git a/package.lisp b/package.lisp index 63d442b..7d925a4 100644 --- a/package.lisp +++ b/package.lisp @@ -26,7 +26,8 @@ ;; From classes.lisp #1=(#:umlsclass #:ucon #:uterm #:ustr #:usrl #:uso #:urank #:udef #:usat #:usab - #:urel #:ucoc #:usty #:uxw #:uxnw #:uxns + #:urel + #: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 #:suppress #:atn #:atv #:vcui @@ -35,7 +36,7 @@ #:rl #:sty2 #:ui #:ui2 #:ui3 #:eui #:bas #:eui2 #:bas2 #:rui #:cui #:aui #:lui #:sui #:wd #:lat #:nstr :cuilist #:rsab #:lat - #:s#def #:s#sty #:s#term #:s#str #:s#lo #:s#sat #:s#rel #:s#coc + #:s#def #:s#sty #:s#term #:s#str #:s#lo #:s#sat #:s#rel #:s#so #:pfstr #:pfstr2 #:lrl #:def #:ts #:cui1 #:cui2 #:rela #:sl #:mg #:rel #:soc #:cot #:cof #:coa #:isn #:fr #:un #:sna #:soui #:hcd #:stt #:str @@ -92,9 +93,6 @@ #:find-cui2-urel-cui #:find-urel-cui2 #:find-ucon-rel-cui2 - #:find-ucoc-cui - #:find-ucoc-cui2 - #:find-ucon-coc-cui2 #:find-usty-sty #:suistr #:print-umlsclass @@ -195,15 +193,11 @@ #:tui-disease-or-syndrome #:ucon-is-tui? #:find-ucon2-tui - #:find-ucon2-coc-tui #:find-ucon2-rel-tui - #:find-ucon2_freq-coc-tui #:find-ucon2-str&sty - #:find-ucon2-coc-str&sty #:find-ucon2-rel-str&sty #:find-ucon2_freq-tui-all #:find-ucon2_freq-rel-tui-all - #:find-ucon2_freq-coc-tui-all #:ucon_freq #:ustr_freq #:usty_freq @@ -212,6 +206,11 @@ ;; from data-structures.lisp #:umls-path #:set-umls-path + + ;; Removed features + ;; MRCOC + ;; #:ucoc #:s#coc #:find-ucoc-cui #:find-ucoc-cui2 #:find-ucon-coc-cui2 #:find-ucon2-coc-tui #:find-ucon2_freq-coc-tui #:find-ucon2-coc-str&sty #:find-ucon2_freq-coc-tui-all + ))) (defpackage umlisp-user @@ -219,5 +218,3 @@ (:import-from :umlisp . #1#) (:export . #1#) (:documentation "User package for UMLisp"))) - - diff --git a/parse-rrf.lisp b/parse-rrf.lisp index 65992bf..5e28ed5 100644 --- a/parse-rrf.lisp +++ b/parse-rrf.lisp @@ -246,11 +246,11 @@ SNOMED SRL changed from 4 to 9. So we create a new scale ~ (lambda (x) (write-to-string (cui-lrl (parse-ui (vff "MRSTY.RRF" "CUI" x)))))) ("MRSTY.RRF" "KLRLUS" "TINYINT" 0 (lambda (x) (write-to-string (cui-lrlus (parse-ui (vff "MRSTY.RRF" "CUI" x)))))) - ("MRCOC.RRF" "KLRL" "TINYINT" 0 + #+mrcoc ("MRCOC.RRF" "KLRL" "TINYINT" 0 (lambda (x) (write-to-string (max (cui-lrl (parse-ui (vff "MRCOC.RRF" "CUI1" x))) (kmrcl:aif (cui-lrl (parse-ui (vff "MRCOC.RRF" "CUI2" x))) kmrcl::it 0))))) - ("MRCOC.RRF" "KLRLUS" "TINYINT" 0 + #+mrcoc ("MRCOC.RRF" "KLRLUS" "TINYINT" 0 (lambda (x) (write-to-string (max (cui-lrlus (parse-ui (vff "MRCOC.RRF" "CUI1" x))) (kmrcl:aif (cui-lrl (parse-ui (vff "MRCOC.RRF" "CUI2" x))) kmrcl::it 0))))) @@ -316,7 +316,7 @@ SNOMED SRL changed from 4 to 9. So we create a new scale ~ (parse-ui (vff "MRXNS_ENG.RRF" "SUI" x))))))) #+nil ("MRREL.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (vff "MRREL.RRF" "CUI2" x))))) - #+nil ("MRCOC.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (vff "MRCOC.RRF" "CUI2" x))))) + #+mrcoc ("MRCOC.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (vff "MRCOC.RRF" "CUI2" x))))) ("MRSAT.RRF" "KCUILUI" "BIGINT" 0 (lambda (x) (write-to-string (make-cuilui @@ -350,12 +350,13 @@ SNOMED SRL changed from 4 to 9. So we create a new scale ~ "Custom columns to create.(filename, col, sqltype, value-func).") (defparameter +index-cols+ - '(("CUI1" "MRCOC") ("CUI" "MRCONSO") ("LUI" "MRCONSO") - ("SRL" "MRCONSO") ("KSRLUS" "MRCONSO") ("AUI" "MRCONSO") ("KPFENG" "MRCONSO") - ("SUI" "MRCONSO") ("SAUI" "MRCONSO") ("CODE" "MRCONSO") - ("SCUI" "MRCONSO") - ("CUI" "MRDEF") - ("CUI1" "MRREL") ("CUI2" "MRREL") ("SAB" "MRREL") + '( #+mrcoc ("CUI1" "MRCOC") #+mrcoc ("KLRL" "MRCOC") #+mrcoc ("KLRLUS" "MRCOC") + ("CUI" "MRCONSO") ("LUI" "MRCONSO") + ("SRL" "MRCONSO") ("KSRLUS" "MRCONSO") ("AUI" "MRCONSO") ("KPFENG" "MRCONSO") + ("SUI" "MRCONSO") ("SAUI" "MRCONSO") ("CODE" "MRCONSO") + ("SCUI" "MRCONSO") + ("CUI" "MRDEF") + ("CUI1" "MRREL") ("CUI2" "MRREL") ("SAB" "MRREL") ("RUI" "MRREL") ("AUI1" "MRREL") ("AUI2" "MRREL") ("CUI" "MRSAT") ("LUI" "MRSAT") ("SUI" "MRSAT") ("METAUI" "MRSAT") ("ATN" "MRSAT") @@ -372,8 +373,8 @@ SNOMED SRL changed from 4 to 9. So we create a new scale ~ ("KCUISUI" "MRXNS_ENG") ("KCUISUI" "MRXW_NONENG") ("KSRL" "MRDEF") ("KSRL" "MRRANK")("KSRL" "MRREL") ("KSRL" "MRSAT") ("KSRLUS" "MRDEF") ("KSRLUS" "MRRANK")("KSRLUS" "MRREL") ("KSRLUS" "MRSAT") - ("KLRL" "MRCOC") ("KLRL" "MRSTY") ("KLRL" "MRXW_ENG") ("KLRL" "MRXNW_ENG") - ("KLRLUS" "MRCOC") ("KLRLUS" "MRSTY") ("KLRLUS" "MRXW_ENG") ("KLRLUS" "MRXNW_ENG") + ("KLRL" "MRSTY") ("KLRL" "MRXW_ENG") ("KLRL" "MRXNW_ENG") + ("KLRLUS" "MRSTY") ("KLRLUS" "MRXW_ENG") ("KLRLUS" "MRXNW_ENG") ("KLRL" "MRXNS_ENG") ("KLRL" "MRXW_NONENG") ("KLRLUS" "MRXNS_ENG") ("KLRLUS" "MRXW_NONENG") ;; LEX indices @@ -461,6 +462,3 @@ SNOMED SRL changed from 4 to 9. So we create a new scale ~ (defun gen-ufiles-custom () (make-ufile "META" "MRXW_NONENG.RRF" "Custom NonEnglish Index" 5 0 0 (fields (find-ufile "MRXW_ENG.RRF")))) - - - diff --git a/sql-classes.lisp b/sql-classes.lisp index 7736eb6..d1e19f3 100644 --- a/sql-classes.lisp +++ b/sql-classes.lisp @@ -495,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 @@ -507,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 @@ -518,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 diff --git a/sql.lisp b/sql.lisp index 1630562..80e068d 100644 --- a/sql.lisp +++ b/sql.lisp @@ -22,8 +22,9 @@ (:2006ad . "MTS2006AD") (:2009ab . "MTS2009AB") (:2010aa . "MTS2010AA") - (:2012ab . "MTS2012AB"))) -(defvar +default-umls-db+ "MTS2012AA_ALL") + (:2012ab . "MTS2012AB") + (:2014ab . "MTS2014AB"))) +(defvar +default-umls-db+ "MTS2014AB_ALL") (defun lookup-db-name (db) (cdr (assoc (ensure-keyword db) +umls-sql-map+))) @@ -39,21 +40,21 @@ (keyword (setq *umls-sql-db* (lookup-db-name db))))) -(defvar *umls-sql-user* "secret") +(defvar *umls-sql-user* "umls") (defun umls-sql-user () *umls-sql-user*) (defun set-umls-sql-user (u) (sql-disconnect-pooled) (setq *umls-sql-user* u)) -(defvar *umls-sql-passwd* "secret") +(defvar *umls-sql-passwd* "umlspw") (defun umls-sql-passwd () *umls-sql-passwd*) (defun set-umls-sql-passwd (p) (sql-disconnect-pooled) (setq *umls-sql-passwd* p)) -(defvar *umls-sql-host* "localhost") +(defvar *umls-sql-host* "tiger.med-info.com") (defun umls-sql-host () *umls-sql-host*) (defun set-umls-sql-host (h)