From 88be55a3921b3078570bb737da197c671117a719 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Mon, 8 Jan 2007 12:34:04 +0000 Subject: [PATCH] r11478: generate custom columns by dynamically finding position of dependant columns from MRFILE --- create-sql.lisp | 10 ++- parse-common.lisp | 42 +++++++++-- parse-rrf.lisp | 183 ++++++++++++++++++++++++++-------------------- utils.lisp | 11 +-- 4 files changed, 152 insertions(+), 94 deletions(-) diff --git a/create-sql.lisp b/create-sql.lisp index fc8fc84..697ecb0 100644 --- a/create-sql.lisp +++ b/create-sql.lisp @@ -421,9 +421,9 @@ This is much faster that using create-umls-db-insert." (declare (optimize (speed 3) (space 0))) (ensure-ucols+ufiles) (let ((max 0)) - (declare (fixnum max)) + (declare (type (integer 0 1000000) max)) (dolist (ucol *umls-cols*) - (when (> (cmax ucol) max) + (when (> (the (integer 0 1000000) (cmax ucol)) max) (setq max (cmax ucol)))) max)) @@ -434,7 +434,11 @@ This is much faster that using create-umls-db-insert." (let ((rowsizes '())) (dolist (file *umls-files*) (let ((row 0)) + (declare (type (integer 0 1000000) row)) (dolist (ucol (ucols file)) - (incf row (1+ (cmax ucol)))) + (let* ((col-max (cmax ucol)) + (max-with-delim (1+ col-max))) + (declare (type (integer 0 1000000) col-max max-with-delim)) + (incf row max-with-delim))) (push row rowsizes))) (car (sort rowsizes #'>)))) diff --git a/parse-common.lisp b/parse-common.lisp index 96f7b8d..a0c7c2a 100644 --- a/parse-common.lisp +++ b/parse-common.lisp @@ -23,12 +23,14 @@ (handler-case (when (or alwaysclear (null *umls-files*)) (setf *umls-cols* nil *umls-files* nil) - (gen-ucols) (gen-ufiles) + (gen-ucols) + (set-ucols-for-ufiles *umls-files*) (ensure-field-lengths)) - (error (e) - (setf *umls-cols* nil *umls-files* nil) - (error e))) + (error (e) + (warn "Error reading ucols+ufiles: ~A." e) + (setf *umls-cols* nil *umls-files* nil) + nil)) t) @@ -123,12 +125,13 @@ Currently, these are the LEX and NET files." "Returns a list of FILENAME MAX AV" (declare (optimize (speed 3) (safety 0))) (let (fields-max fields-av num-fields (count-lines 0)) + (declare (fixnum count-lines)) (with-umls-ufile (line ufile) (unless num-fields (setq num-fields (length line)) (setq fields-max (make-array num-fields :element-type 'fixnum :initial-element 0)) - (setq fields-av (make-array num-fields :element-type 'number + (setq fields-av (make-array num-fields :element-type '(or integer float) :initial-element 0))) (dotimes (i num-fields) (declare (fixnum i)) @@ -138,6 +141,8 @@ Currently, these are the LEX and NET files." (if *octet-sql-storage* (ext:convert-string-to-bytes str charset:utf-8) str)))) + #-(and clisp unicode) (declare (string str)) + (declare (type (integer 0 10000000) len)) (incf (aref fields-av i) len) (when (> len (aref fields-max i)) (setf (aref fields-max i) len)))) @@ -223,7 +228,27 @@ Currently, these are the LEX and NET files." (defun find-ufile (filename) "Returns umls-file structure for a filename" - (find-if #'(lambda (f) (string-equal filename (fil f))) *umls-files*)) + (find-if #'(lambda (f) (string= filename (fil f))) *umls-files*)) + +(defvar *position-hash* (make-hash-table :test 'equal)) + +(defun position-field-file (filename fieldname) + "Returns the position of a field in a file" + (let ((key (cons filename fieldname))) + (multiple-value-bind (pos found) (gethash key *position-hash*) + (if found + (return-from position-field-file pos))) + + (let ((ufile (find-ufile filename))) + (unless ufile + (warn "Unable to find ufile for filename ~A." filename) + (return-from position-field-file nil)) + (let ((pos (position fieldname (fields ufile) :test #'string=))) + (unless pos + (warn "Unable to find field ~A in ufile ~S." fieldname ufile) + (return-from position-field-file nil)) + (setf (gethash key *position-hash*) pos) + pos)))) (defun find-ucols-for-ufile (ufile) "Returns list of umls-cols for a file structure" @@ -268,9 +293,12 @@ append a unique number (starting at 2) onto a column name that is repeated in th :des des :cls cls :rws rws :bts bts :fields fields :table (filename-to-tablename file)))) - (setf (ucols ufile) (find-ucols-for-ufile ufile)) ufile))) +(defun set-ucols-for-ufiles (ufiles) + (dolist (ufile ufiles) + (setf (ucols ufile) (find-ucols-for-ufile ufile)))) + (defun datatype-for-colname (colname) "Return datatype for column name" (second (find colname +col-datatypes+ :key #'car :test #'string-equal))) diff --git a/parse-rrf.lisp b/parse-rrf.lisp index d54c6b2..8a1bb1e 100644 --- a/parse-rrf.lisp +++ b/parse-rrf.lisp @@ -50,20 +50,22 @@ used in the United States. We create a new scale (SRLUS) where SRL to SRLUS mapp (sab-srl-hash nil) (sab-srlus-hash nil)) ;; SRL by SAB + (defun clear-preparse-hash-tables () + (clrhash pfstr-hash) + (clrhash cui-lrl-hash) + (clrhash lui-lrl-hash) + (clrhash sui-lrl-hash) + (clrhash cuisui-lrl-hash) + (clrhash cui-lrlus-hash) + (clrhash lui-lrlus-hash) + (clrhash sui-lrlus-hash) + (clrhash cuisui-lrlus-hash) + (clrhash sab-srl-hash) + (clrhash sab-srlus-hash)) + (defun make-preparse-hash-table () (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 cui-lrlus-hash) - (clrhash lui-lrlus-hash) - (clrhash sui-lrlus-hash) - (clrhash cuisui-lrlus-hash) - (clrhash sab-srl-hash) - (clrhash sab-srlus-hash)) + (clear-preparse-hash-tables) (setf pfstr-hash (make-hash-table :size 1500000) cui-lrl-hash (make-hash-table :size 1500000) @@ -134,7 +136,7 @@ used in the United States. We create a new scale (SRLUS) where SRL to SRLUS mapp )) ;; closure - + (defun set-lrl-hash (key srl hash) "Set the least restrictive level in hash table" (declare (fixnum srl)) @@ -158,13 +160,13 @@ used in the United States. We create a new scale (SRLUS) where SRL to SRLUS mapp '(("AV" sql-f) ("BTS" sql-i) ("CLS" sql-i) ("COF" sql-i) ("CUI1" sql-u) ("AUI" sql-u) ("AUI1" sql-u) ("AUI2" sql-u) ("PCUI" sql-u) ("PLUI" sql-u) ("PAUI" sql-u) ("RUI" sql-u) - ("CUI2" sql-u) ("CUI" sql-u) ("CXN" sql-s) ("FR" sql-i) + ("CUI2" sql-u) ("CUI" sql-u) ("CXN" sql-s) ("FR" sql-i) ("LUI" sql-u) ("MAX" sql-s) ("MIN" sql-s) ("RANK" sql-s) ("REF" sql-c) ("PTR" sql-c) ("RNK" sql-s) ("RWS" sql-i) ("SRL" sql-t) ("SUI" sql-u) ("TUI" sql-u) ("MAPRANK" sql-s) ;;; Custom columns - ("KCUISUI" sql-l) ("KCUILUI" sql-l) + ("KCUISUI" sql-l) ("KCUILUI" sql-l) ("KSRL" sql-t) ("KSRLUS" sql-t) ("LRL" sql-t) ("LRLUS" sql-t) ("KCUILRL" sql-t) ("KLUILRL" sql-t) ("KSUILRL" sql-t) ("KLRL" sql-t) ("KCUILRLUS" sql-t) ("KLUILRLUS" sql-t) ("KSUILRLUS" sql-t) ("KLRLUS" sql-t) @@ -185,6 +187,14 @@ used in the United States. We create a new scale (SRLUS) where SRL to SRLUS mapp '(("KCON" "SELECT CUI,STR FROM MRCONSO WHERE STT='PF' AND TS='P' AND ISPREF='Y' AND LAT='ENG'")) "Custom tables to create") +(declaim (inline vff)) +(defun vff (filename fieldname record) + (let ((pos (position-field-file filename fieldname))) + (unless pos + (error "Did not find fieldname ~A in filename ~A." fieldname filename)) + (locally (declare (fixnum pos)) + (nth pos record)))) + (defparameter +custom-cols+ '(#+nil ("MRCONSO.RRF" "KPFSTR" "TEXT" (slot-value (find-ucol "STR" "MRCONSO.RRF") 'max) @@ -197,118 +207,133 @@ used in the United States. We create a new scale (SRLUS) where SRL to SRLUS mapp "1" "0"))) ("MRCONSO.RRF" "KCUISUI" "BIGINT" 0 - (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 5 x)))))) + (lambda (x) (write-to-string (make-cuisui (parse-ui (vff "MRCONSO.RRF" "CUI" x)) + (parse-ui (vff "MRCONSO.RRF" "SUI" x)))))) ("MRCONSO.RRF" "KCUILUI" "BIGINT" 0 - (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 3 x)))))) + (lambda (x) (write-to-string (make-cuilui (parse-ui (vff "MRCONSO.RRF" "CUI" x)) + (parse-ui (vff "MRCONSO.RRF" "SUI" x)))))) ("MRCONSO.RRF" "KCUILRL" "TINYINT" 0 - (lambda (x) (write-to-string (cui-lrl (parse-ui (nth 0 x)))))) + (lambda (x) (write-to-string (cui-lrl (parse-ui (vff "MRCONSO.RRF" "CUI" x)))))) ("MRCONSO.RRF" "KCUILRLUS" "TINYINT" 0 - (lambda (x) (write-to-string (cui-lrlus (parse-ui (nth 0 x)))))) + (lambda (x) (write-to-string (cui-lrlus (parse-ui (vff "MRCONSO.RRF" "CUI" x)))))) ("MRCONSO.RRF" "KLUILRL" "TINYINT" 0 - (lambda (x) (write-to-string (lui-lrl (parse-ui (nth 3 x)))))) + (lambda (x) (write-to-string (lui-lrl (parse-ui (vff "MRCONSO.RRF" "LUI" x)))))) ("MRCONSO.RRF" "KLUILRLUS" "TINYINT" 0 - (lambda (x) (write-to-string (lui-lrlus (parse-ui (nth 3 x)))))) + (lambda (x) (write-to-string (lui-lrlus (parse-ui (vff "MRCONSO.RRF" "LUI" x)))))) ("MRCONSO.RRF" "KSUILRL" "TINYINT" 0 - (lambda (x) (write-to-string (sui-lrl (parse-ui (nth 5 x)))))) + (lambda (x) (write-to-string (sui-lrl (parse-ui (vff "MRCONSO.RRF" "SUI" x)))))) ("MRCONSO.RRF" "KSUILRLUS" "TINYINT" 0 - (lambda (x) (write-to-string (sui-lrlus (parse-ui (nth 5 x)))))) + (lambda (x) (write-to-string (sui-lrlus (parse-ui (vff "MRCONSO.RRF" "SUI" x)))))) ("MRCONSO.RRF" "KSRLUS" "TINYINT" 0 - (lambda (x) (write-to-string (srl-to-srlus (parse-integer (nth 15 x)))))) + (lambda (x) (write-to-string (srl-to-srlus (parse-integer (vff "MRCONSO.RRF" "SRL" x)))))) ("MRSAB.RRF" "KSRLUS" "TINYINT" 0 - (lambda (x) (write-to-string (srl-to-srlus (parse-integer (nth 3 x)))))) + (lambda (x) (write-to-string (srl-to-srlus (parse-integer (vff "MRSAB.RRF" "SRL" x)))))) ("MRSTY.RRF" "KLRL" "TINYINT" 0 - (lambda (x) (write-to-string (cui-lrl (parse-ui (nth 0 x)))))) + (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 (nth 0 x)))))) + (lambda (x) (write-to-string (cui-lrlus (parse-ui (vff "MRSTY.RRF" "CUI" x)))))) ("MRCOC.RRF" "KLRL" "TINYINT" 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))))) + (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 (lambda (x) (write-to-string - (max (cui-lrlus (parse-ui (nth 0 x))) - (kmrcl:aif (cui-lrl (parse-ui (nth 1 x))) kmrcl::it 0))))) + (max (cui-lrlus (parse-ui (vff "MRCOC.RRF" "CUI1" x))) + (kmrcl:aif (cui-lrl (parse-ui (vff "MRCOC.RRF" "CUI2" x))) kmrcl::it 0))))) ("MRSAT.RRF" "KSRL" "TINYINT" 0 - (lambda (x) (write-to-string (sab-srl (nth 9 x))))) + (lambda (x) (write-to-string (sab-srl (vff "MRSAT.RRF" "SAB" x))))) ("MRSAT.RRF" "KSRLUS" "TINYINT" 0 - (lambda (x) (write-to-string (sab-srlus (nth 9 x))))) + (lambda (x) (write-to-string (sab-srlus (vff "MRSAT.RRF" "SAB" x))))) ("MRREL.RRF" "KSRL" "TINYINT" 0 - (lambda (x) (write-to-string (sab-srl (nth 10 x))))) + (lambda (x) (write-to-string (sab-srl (vff "MRREL.RRF" "SAB" x))))) ("MRREL.RRF" "KSRLUS" "TINYINT" 0 - (lambda (x) (write-to-string (sab-srlus (nth 10 x))))) + (lambda (x) (write-to-string (sab-srlus (vff "MRREL.RRF" "SAB" x))))) ("MRRANK.RRF" "KSRL" "TINYINT" 0 - (lambda (x) (write-to-string (sab-srl (nth 1 x))))) + (lambda (x) (write-to-string (sab-srl (vff "MRRANK.RRF" "SAB" x))))) ("MRRANK.RRF" "KSRLUS" "TINYINT" 0 - (lambda (x) (write-to-string (sab-srlus (nth 1 x))))) + (lambda (x) (write-to-string (sab-srlus (vff "MRRANK.RRF" "SAB" x))))) ("MRHIER.RRF" "KSRL" "TINYINT" 0 - (lambda (x) (write-to-string (sab-srl (nth 4 x))))) + (lambda (x) (write-to-string (sab-srl (vff "MRHIER.RRF" "SAB" x))))) ("MRHIER.RRF" "KSRLUS" "TINYINT" 0 - (lambda (x) (write-to-string (sab-srlus (nth 4 x))))) + (lambda (x) (write-to-string (sab-srlus (vff "MRHIER.RRF" "SAB" x))))) ("MRMAP.RRF" "KSRL" "TINYINT" 0 - (lambda (x) (write-to-string (sab-srl (nth 1 x))))) + (lambda (x) (write-to-string (sab-srl (vff "MRMAP.RRF" "MAPSETSAB" x))))) ("MRMAP.RRF" "KSRLUS" "TINYINT" 0 - (lambda (x) (write-to-string (sab-srlus (nth 1 x))))) + (lambda (x) (write-to-string (sab-srlus (vff "MRMAP.RRF" "MAPSETSAB" x))))) ("MRSMAP.RRF" "KSRL" "TINYINT" 0 - (lambda (x) (write-to-string (sab-srl (nth 1 x))))) + (lambda (x) (write-to-string (sab-srl (vff "MRSMAP.RRF" "MAPSETSAB" x))))) ("MRSMAP.RRF" "KSRLUS" "TINYINT" 0 - (lambda (x) (write-to-string (sab-srlus (nth 1 x))))) + (lambda (x) (write-to-string (sab-srlus (vff "MRSMAP.RRF" "MAPSETSAB" x))))) ("MRDEF.RRF" "KSRL" "TINYINT" 0 - (lambda (x) (write-to-string (sab-srl (nth 4 x))))) + (lambda (x) (write-to-string (sab-srl (vff "MRDEF.RRF" "SAB" x))))) ("MRDEF.RRF" "KSRLUS" "TINYINT" 0 - (lambda (x) (write-to-string (sab-srlus (nth 4 x))))) + (lambda (x) (write-to-string (sab-srlus (vff "MRDEF.RRF" "SAB" x))))) ("MRXW_ENG.RRF" "KLRL" "TINYINT" 0 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui - (parse-ui (nth 2 x)) - (parse-ui (nth 4 x))))))) + (parse-ui (vff "MRXW_ENG.RRF" "CUI" x)) + (parse-ui (vff "MRXW_ENG.RRF" "SUI" x))))))) ("MRXW_ENG.RRF" "KLRLUS" "TINYINT" 0 (lambda (x) (write-to-string (cuisui-lrlus (make-cuisui - (parse-ui (nth 2 x)) - (parse-ui (nth 4 x))))))) + (parse-ui (vff "MRXW_ENG.RRF" "CUI" x)) + (parse-ui (vff "MRXW_ENG.RRF" "SUI" x))))))) ("MRXW_NONENG.RRF" "KLRL" "TINYINT" 0 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui - (parse-ui (nth 2 x)) - (parse-ui (nth 4 x))))))) + (parse-ui (vff "MRXW_NONENG.RRF" "CUI" x)) + (parse-ui (vff "MRXW_NONENG.RRF" "SUI" x))))))) ("MRXW_NONENG.RRF" "KLRLUS" "TINYINT" 0 (lambda (x) (write-to-string (cuisui-lrlus (make-cuisui - (parse-ui (nth 2 x)) - (parse-ui (nth 4 x))))))) + (parse-ui (vff "MRXW_NONENG.RRF" "CUI" x)) + (parse-ui (vff "MRXW_NONENG.RRF" "SUI" x))))))) ("MRXNW_ENG.RRF" "KLRL" "TINYINT" 0 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui - (parse-ui (nth 2 x)) - (parse-ui (nth 4 x))))))) + (parse-ui (vff "MRXNW_ENG.RRF" "CUI" x)) + (parse-ui (vff "MRXNW_ENG.RRF" "SUI" x))))))) ("MRXNW_ENG.RRF" "KLRLUS" "TINYINT" 0 (lambda (x) (write-to-string (cuisui-lrlus (make-cuisui - (parse-ui (nth 2 x)) - (parse-ui (nth 4 x))))))) + (parse-ui (vff "MRXNW_ENG.RRF" "CUI" x)) + (parse-ui (vff "MRXNW_ENG.RRF" "SUI" x))))))) ("MRXNS_ENG.RRF" "KLRL" "TINYINT" 0 (lambda (x) (write-to-string (cuisui-lrl (make-cuisui - (parse-ui (nth 2 x)) - (parse-ui (nth 4 x))))))) + (parse-ui (vff "MRXNS_ENG.RRF" "CUI" x)) + (parse-ui (vff "MRXNS_ENG.RRF" "SUI" x))))))) ("MRXNS_ENG.RRF" "KLRLUS" "TINYINT" 0 (lambda (x) (write-to-string (cuisui-lrlus (make-cuisui - (parse-ui (nth 2 x)) - (parse-ui (nth 4 x))))))) + (parse-ui (vff "MRXNS_ENG.RRF" "CUI" x)) + (parse-ui (vff "MRXNS_ENG.RRF" "SUI" x))))))) #+nil ("MRREL.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (nth 4 x))))) #+nil ("MRCOC.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (nth 2 x))))) + ("MRSAT.RRF" "KCUILUI" "BIGINT" 0 - (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 1 x)))))) + (lambda (x) (write-to-string (make-cuilui + (parse-ui (vff "MRSAT.RRF" "CUI" x)) + (parse-ui (vff "MRSAT.RRF" "LUI" x)))))) ("MRSAT.RRF" "KCUISUI" "BIGINT" 0 - (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 2 x)))))) + (lambda (x) (write-to-string (make-cuisui + (parse-ui (vff "MRSAT.RRF" "CUI" x)) + (parse-ui (vff "MRSAT.RRF" "SUI" x)))))) ("MRXW_ENG.RRF" "KCUISUI" "BIGINT" 0 - (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x)))))) + (lambda (x) (write-to-string (make-cuisui + (parse-ui (vff "MRXW_ENG.RRF" "CUI" x)) + (parse-ui (vff "MRXW_ENG.RRF" "SUI" x)))))) ("MRXNW_ENG.RRF" "KCUISUI" "BIGINT" 0 - (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x)))))) + (lambda (x) (write-to-string (make-cuisui + (parse-ui (vff "MRXNW_ENG.RRF" "CUI" x)) + (parse-ui (vff "MRXNW_ENG.RRF" "SUI" x)))))) ("MRXNS_ENG.RRF" "KCUISUI" "BIGINT" 0 - (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x)))))) - ("MRXW_NONENG.RRF" "LAT" "VARCHAR" 3 (lambda (x) (nth 0 x))) - ("MRXW_NONENG.RRF" "WD" "VARCHAR" 200 (lambda (x) (nth 1 x))) - ("MRXW_NONENG.RRF" "CUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 2 x))))) - ("MRXW_NONENG.RRF" "LUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 3 x))))) - ("MRXW_NONENG.RRF" "SUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 4 x))))) + (lambda (x) (write-to-string (make-cuisui + (parse-ui (vff "MRXNS_ENG.RRF" "CUI" x)) + (parse-ui (vff "MRXNS_ENG.RRF" "SUI" x)))))) + ("MRXW_NONENG.RRF" "LAT" "VARCHAR" 3 (lambda (x) (vff "MRXW_NONENG.RRF" "LAT" x))) + ("MRXW_NONENG.RRF" "WD" "VARCHAR" 200 (lambda (x) (vff "MRXW_NONENG.RRF" "WD" x))) + ("MRXW_NONENG.RRF" "CUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (vff "MRXW_NONENG.RRF" "CUI" x))))) + ("MRXW_NONENG.RRF" "LUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (vff "MRXW_NONENG.RRF" "LUI" x))))) + ("MRXW_NONENG.RRF" "SUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (vff "MRXW_NONENG.RRF" "SUI" x))))) ("MRXW_NONENG.RRF" "KCUISUI" "BIGINT" 0 - (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))) - "Custom columns to create.(filename, col, sqltype, value-func).") + (lambda (x) (write-to-string (make-cuisui + (parse-ui (vff "MRXW_NONENG.RRF" "CUI" x)) + (parse-ui (vff "MRXW_NONENG.RRF" "SUI" x))))))) + "Custom columns to create.(filename, col, sqltype, value-func).") (defparameter +index-cols+ '(("CUI1" "MRCOC") ("CUI" "MRCONSO") ("LUI" "MRCONSO") @@ -325,14 +350,14 @@ used in the United States. We create a new scale (SRLUS) where SRL to SRLUS mapp ("SAB" "MRHIER") #+ignore ("NSTR" "MRXNS_ENG" 10) ("CUI" "MRXNW_ENG") ("NWD" "MRXNW_ENG") ("WD" "MRXW_ENG") - ("KCUISUI" "MRCONSO") ("KCUILUI" "MRCONSO") + ("KCUISUI" "MRCONSO") ("KCUILUI" "MRCONSO") ("KCUILRL" "MRCONSO") ("KLUILRL" "MRCONSO") ("KSUILRL" "MRCONSO") ("KCUILRLUS" "MRCONSO") ("KLUILRLUS" "MRCONSO") ("KSUILRLUS" "MRCONSO") ("KCUISUI" "MRSAT") ("KCUILUI" "MRSAT") ("KCUISUI" "MRXW_ENG") ("KCUISUI" "MRXNW_ENG") ("KCUISUI" "MRXNS_ENG") ("KCUISUI" "MRXW_NONENG") - ("KSRL" "MRDEF") ("KSRL" "MRRANK")("KSRL" "MRREL") ("KSRL" "MRSAT") - ("KSRLUS" "MRDEF") ("KSRLUS" "MRRANK")("KSRLUS" "MRREL") ("KSRLUS" "MRSAT") + ("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" "MRXNS_ENG") ("KLRL" "MRXW_NONENG") @@ -363,9 +388,9 @@ used in the United States. We create a new scale (SRLUS) where SRL to SRLUS mapp (defun gen-ucols () (add-ucols (gen-ucols-meta)) - (add-ucols (gen-ucols-custom)) (add-ucols (gen-ucols-generic "LRFLD")) - (add-ucols (gen-ucols-generic "SRFLD"))) + (add-ucols (gen-ucols-generic "SRFLD")) + (add-ucols (gen-ucols-custom))) (defun gen-ucols-meta () "Initialize all umls columns" @@ -383,7 +408,7 @@ used in the United States. We create a new scale (SRLUS) where SRL to SRLUS mapp collect (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)))) + :custom-value-fun (compile nil (nth 4 customcol))))) (defun gen-ucols-generic (col-filename) "Initialize for generic (LEX/NET) columns" diff --git a/utils.lisp b/utils.lisp index ba75eea..358a141 100644 --- a/utils.lisp +++ b/utils.lisp @@ -35,10 +35,10 @@ (defun parse-ui (s &optional (nullvalue 0)) "Return integer value for a UMLS unique identifier." (declare (simple-string s) - (optimize (speed 3) (safety 0))) + (optimize (speed 3) (safety 0))) (if (< (length s) 2) nullvalue - (nth-value 0 (parse-integer s :start 1)))) + (nth-value 0 (parse-integer s :start 1)))) (defun parse-cui (cui) (declare (optimize (speed 3) (safety 0))) @@ -115,9 +115,10 @@ #-(or 64bit x86-64) (defun make-cuisui (cui sui) - (declare (fixnum cui sui) - (optimize (speed 3) (safety 0) (space 0))) - (+ (* +cuisui-scale+ cui) sui)) + (when (and cui sui) + (locally (declare (fixnum cui sui) + (optimize (speed 3) (safety 0) (space 0))) + (+ (* +cuisui-scale+ cui) sui)))) #+(or 64bit x86-64) (defun make-cuilui (cui lui) -- 2.34.1