parse-rrf.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:     parse-rrf.lisp
   6 ;;;; Purpose:  Parsing and SQL insertion routines for UMLisp which may
   7 ;;;;           change from year to year
   8 ;;;; Author:   Kevin M. Rosenberg
   9 ;;;; Created:  Apr 2000
  10 ;;;;
  11 ;;;; $Id$
  12 ;;;;
  13 ;;;; This file, part of UMLisp, is
  14 ;;;;    Copyright (c) 2000-2006 by Kevin M. Rosenberg, M.D.
  15 ;;;;
  16 ;;;; UMLisp users are granted the rights to distribute and use this software
  17 ;;;; as governed by the terms of the GNU General Public License.
  18 ;;;; *************************************************************************
  19
  20 (in-package #:umlisp)
  21
  22 ;;; Pre-read data for custom fields into hash tables
  23 (defvar *preparse-hash-init?* nil)
  24
  25 (eval-when (:compile-toplevel :load-toplevel :execute)
  26 (let ((pfstr-hash nil)      ;; Preferred concept strings by CUI
  27       (cui-lrl-hash nil)    ;; LRL by CUI
  28       (lui-lrl-hash nil)    ;; LRL by LUI
  29       (sui-lrl-hash nil)    ;; LRL by SUI
  30       (cuisui-lrl-hash nil) ;; LRL by CUISUI
  31       (sab-srl-hash nil))   ;; SRL by SAB
  32
  33   (defun make-preparse-hash-table ()
  34     (if sui-lrl-hash
  35         (progn
  36           (clrhash pfstr-hash)
  37           (clrhash cui-lrl-hash)
  38           (clrhash lui-lrl-hash)
  39           (clrhash sui-lrl-hash)
  40           (clrhash cuisui-lrl-hash)
  41           (clrhash sab-srl-hash))
  42       (setf
  43           pfstr-hash (make-hash-table :size 1300000)
  44           cui-lrl-hash (make-hash-table :size 1300000)
  45           lui-lrl-hash (make-hash-table :size 4600000)
  46           sui-lrl-hash (make-hash-table :size 5100000)
  47           cuisui-lrl-hash (make-hash-table :size 2000000)
  48           sab-srl-hash (make-hash-table :size 100 :test 'equal))))
  49
  50   (defun ensure-preparse (&optional (force-read nil))
  51     (when (and *preparse-hash-init?* (not force-read))
  52       (return-from ensure-preparse 'already-done))
  53     (make-preparse-hash-table)
  54     (let ((counter 0))
  55       (declare (fixnum counter))
  56       (with-umls-file (line "MRCONSO.RRF")
  57         (let ((cui (parse-ui (nth 0 line)))
  58               (lui (parse-ui (nth 3 line)))
  59               (sui (parse-ui (nth 5 line)))
  60               (sab (nth 11 line))
  61               (srl (parse-integer (nth 15 line))))
  62           #+sbcl
  63           (when (= 0 (mod (incf counter) 100000)) (sb-ext:gc :full t))
  64
  65           ;; pfstr deprecated by KPKENG field in MRCONSO
  66           #+nil
  67           (unless (gethash cui pfstr-hash)  ;; if haven't stored pfstr for cui
  68             (when (and (string-equal (nth 1 line) "ENG") ; LAT
  69                        (string-equal (nth 2 line) "P") ; ts
  70                        (string-equal (nth 4 line) "PF")) ; stt
  71               (setf (gethash cui pfstr-hash) (nth 14 line))))
  72           (set-lrl-hash cui srl cui-lrl-hash)
  73           (set-lrl-hash lui srl lui-lrl-hash)
  74           (set-lrl-hash sui srl sui-lrl-hash)
  75           (set-lrl-hash (make-cuisui cui sui) srl cuisui-lrl-hash)
  76           (multiple-value-bind (val found) (gethash sab sab-srl-hash)
  77             (declare (ignore val))
  78             (unless found
  79               (setf (gethash sab sab-srl-hash) srl))))))
  80     (setq *preparse-hash-init?* t)
  81     t)
  82
  83   #+nil (defun pfstr-hash (cui) (gethash cui pfstr-hash))
  84   (defun cui-lrl (cui)    (gethash cui cui-lrl-hash))
  85   (defun lui-lrl (lui)    (gethash lui lui-lrl-hash))
  86   (defun sui-lrl (sui)    (gethash sui sui-lrl-hash))
  87   (defun sab-srl (sab)    (aif (gethash sab sab-srl-hash) it 0))
  88   (defun cuisui-lrl (cuisui) (gethash cuisui cuisui-lrl-hash))
  89
  90 )) ;; closure
  91
  92 (defun set-lrl-hash (key lrl hash)
  93   "Set the least restrictive level in hash table"
  94   (multiple-value-bind (hash-lrl found) (gethash key hash)
  95     (if (or (not found) (< lrl hash-lrl))
  96         (setf (gethash key hash) lrl))))
  97
  98 ;; UMLS file and column structures
  99 ;;; SQL datatypes symbols
 100 ;;; sql-u - Unique identifier
 101 ;;; sql-s - Small integer (16-bit)
 102 ;;; sql-i - Integer (32-bit)
 103 ;;; sql-l - Big integer (64-bit)
 104 ;;; sql-f - Floating point
 105 ;;; sql-c - Character data
 106
 107 (defparameter +col-datatypes+
 108     '(("AV" sql-f) ("BTS" sql-i) ("CLS" sql-i) ("COF" sql-i) ("CUI1" sql-u)
 109       ("AUI" sql-u) ("AUI1" sql-u) ("AUI2" sql-u) ("PCUI" sql-u)
 110       ("PLUI" sql-u) ("PAUI" sql-u) ("RUI" sql-u)
 111       ("CUI2" sql-u) ("CUI" sql-u) ("CXN" sql-s) ("FR" sql-i) ("LRL" sql-s)
 112       ("LUI" sql-u) ("MAX" sql-s) ("MIN" sql-s) ("RANK" sql-s) ("REF" sql-c)
 113       ("PTR" sql-c)
 114       ("RNK" sql-s) ("RWS" sql-i) ("SRL" sql-s) ("SUI" sql-u) ("TUI" sql-u)
 115       ("MAPRANK" sql-s)
 116       ;;; Custom columns
 117       ("KCUISUI" sql-l) ("KCUILUI" sql-l) ("KCUILRL" sql-i) ("KLUILRL" sql-i)
 118       ("KSUILRL" sql-i)
 119       ("KSRL" sql-i) ("KLRL" sql-i)
 120       ;;; LEX columns
 121       ("EUI" sql-u) ("EUI2" sql-u)
 122       ;;; Semantic net columns
 123       ("UI" sql-u) ("UI2" sql-u) ("UI3" sql-u)
 124       ;; New fields for 2002AD
 125       ("RCUI" sql-u) ("VCUI" sql-u) ("CFR" sql-i) ("TFR" sql-i)
 126       ;; New fields for 2004AA
 127       ("MAPSETCUI" sql-u)
 128       )
 129     "SQL data types for each non-string column")
 130
 131 (defparameter +custom-tables+
 132     nil
 133   #+ignore
 134   '(("KCON" "SELECT CUI,STR FROM MRCONSO WHERE STT='PF' AND TS='P' AND ISPREF='Y' AND LAT='ENG'"))
 135   "Custom tables to create")
 136
 137 (defparameter +custom-cols+
 138     '(#+nil ("MRCONSO.RRF" "KPFSTR" "TEXT"
 139              (slot-value (find-ucol "STR" "MRCONSO.RRF") 'max)
 140              (lambda (x) (pfstr-hash (parse-ui (nth 0 x)))))
 141       ;; Set to 1 if term is prefered term for english
 142       ("MRCONSO.RRF" "KPFENG" "TINYINT" 0
 143        (lambda (x)  (if (and (string-equal (nth 1 x) "ENG") ; LAT
 144                              (string-equal (nth 2 x) "P") ; ts
 145                              (string-equal (nth 4 x) "PF")) ; stt
 146                       "1"
 147                       "0")))
 148       ("MRCONSO.RRF" "KCUISUI" "BIGINT" 0
 149        (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 5 x))))))
 150       ("MRCONSO.RRF" "KCUILUI" "BIGINT" 0
 151        (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 3 x))))))
 152       ("MRCONSO.RRF" "KCUILRL" "SMALLINT" 0
 153        (lambda (x) (write-to-string (lui-lrl (parse-ui (nth 0 x))))))
 154       ("MRCONSO.RRF" "KLUILRL" "SMALLINT" 0
 155        (lambda (x) (write-to-string (lui-lrl (parse-ui (nth 3 x))))))
 156       ("MRCONSO.RRF" "KSUILRL" "SMALLINT" 0
 157        (lambda (x) (write-to-string (sui-lrl (parse-ui (nth 5 x))))))
 158       ("MRSTY.RRF" "KLRL" "SMALLINT" 0
 159        (lambda (x) (write-to-string (cui-lrl (parse-ui (nth 0 x))))))
 160       ("MRCOC.RRF" "KLRL" "SMALLINT" 0
 161        (lambda (x) (write-to-string
 162                     (max (cui-lrl (parse-ui (nth 0 x)))
 163                          (kmrcl:aif (cui-lrl (parse-ui (nth 1 x))) kmrcl::it 0)))))
 164       ("MRSAT.RRF" "KSRL" "SMALLINT" 0
 165        (lambda (x) (write-to-string (sab-srl (nth 9 x)))))
 166       ("MRREL.RRF" "KSRL" "SMALLINT" 0
 167        (lambda (x) (write-to-string (sab-srl (nth 10 x)))))
 168       ("MRRANK.RRF" "KSRL" "SMALLINT" 0
 169        (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
 170       ("MRHIER.RRF" "KSRL" "SMALLINT" 0
 171        (lambda (x) (write-to-string (sab-srl (nth 4 x)))))
 172       ("MRMAP.RRF" "KSRL" "SMALLINT" 0
 173        (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
 174       ("MRSMAP.RRF" "KSRL" "SMALLINT" 0
 175        (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
 176       ("MRDEF.RRF" "KSRL" "SMALLINT" 0
 177        (lambda (x) (write-to-string (sab-srl (nth 4 x)))))
 178       #+nil  ("MRCXT.RRF" "KSRL" "SMALLINT" 0 (lambda (x) (write-to-string (sab-srl (nth 2 x)))))
 179       ("MRXW_ENG.RRF" "KLRL" "SMALLINT" 0
 180        (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
 181                                                  (parse-ui (nth 2 x))
 182                                                  (parse-ui (nth 4 x)))))))
 183       ("MRXW_NONENG.RRF" "KLRL" "SMALLINT" 0
 184        (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
 185                                                  (parse-ui (nth 2 x))
 186                                                  (parse-ui (nth 4 x)))))))
 187       ("MRXNW_ENG.RRF" "KLRL" "SMALLINT" 0
 188        (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
 189                                                  (parse-ui (nth 2 x))
 190                                                  (parse-ui (nth 4 x)))))))
 191       ("MRXNS_ENG.RRF" "KLRL" "SMALLINT" 0
 192        (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
 193                                                  (parse-ui (nth 2 x))
 194                                                  (parse-ui (nth 4 x)))))))
 195
 196       #+nil  ("MRREL.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (nth 4 x)))))
 197       #+nil  ("MRCOC.RRF" "KPFSTR2" "TEXT" 1024 (lambda (x) (pfstr-hash (parse-ui (nth 2 x)))))
 198       ("MRSAT.RRF" "KCUILUI" "BIGINT" 0
 199        (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 1 x))))))
 200       ("MRSAT.RRF" "KCUISUI" "BIGINT" 0
 201        (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 2 x))))))
 202       ("MRXW_ENG.RRF" "KCUISUI" "BIGINT" 0
 203        (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))
 204       ("MRXNW_ENG.RRF" "KCUISUI" "BIGINT" 0
 205        (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))
 206       ("MRXNS_ENG.RRF" "KCUISUI" "BIGINT" 0
 207        (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))
 208       ("MRXW_NONENG.RRF" "LAT" "VARCHAR" 3 (lambda (x) (nth 0 x)))
 209       ("MRXW_NONENG.RRF" "WD"  "VARCHAR" 200  (lambda (x) (nth 1 x)))
 210       ("MRXW_NONENG.RRF" "CUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 2 x)))))
 211       ("MRXW_NONENG.RRF" "LUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 3 x)))))
 212       ("MRXW_NONENG.RRF" "SUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 4 x)))))
 213       ("MRXW_NONENG.RRF" "KCUISUI" "BIGINT" 0
 214        (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x)))))))
 215   "Custom columns to create.(filename, col, sqltype, value-func).")
 216
 217 (defparameter +index-cols+
 218     '(("CUI1" "MRCOC") ("CUI" "MRCONSO") ("LUI" "MRCONSO")
 219       ("SRL" "MRCONSO") ("AUI" "MRCONSO") ("KPFENG" "MRCONSO")
 220       ("SUI" "MRCONSO") ("SAUI" "MRCONSO") ("CODE" "MRCONSO")
 221       ("SCUI" "MRCONSO")
 222       ("CUI" "MRDEF")
 223       ("CUI1" "MRREL") ("CUI2" "MRREL")
 224       ("RUI" "MRREL") ("AUI1" "MRREL") ("AUI2" "MRREL")
 225       ("CUI" "MRSAT") ("LUI" "MRSAT") ("SUI" "MRSAT")
 226       ("METAUI" "MRSAT") ("ATN" "MRSAT")
 227       ("CUI" "MRSTY")  ("TUI" "MRSTY") ("CUI" "MRXNS_ENG")
 228       ("AUI" "MRHIER") ("PTR" "MRHIER" 255) ("CUI" "MRHIER") ("CXN" "MRHIER") ("RELA" "MRHIER") ("PAUI" "MRHIER")
 229       ("SAB" "MRHIER")
 230       #+ignore ("NSTR" "MRXNS_ENG" 10)
 231       ("CUI" "MRXNW_ENG") ("NWD" "MRXNW_ENG") ("WD" "MRXW_ENG")
 232       ("KCUISUI" "MRCONSO") ("KCUILUI" "MRCONSO") ("KCUILRL" "MRCONSO")
 233       ("KLUILRL" "MRCONSO")
 234       ("KCUISUI" "MRSAT")  ("KCUILUI" "MRSAT")
 235       ("KCUISUI" "MRXW_ENG") ("KCUISUI" "MRXNW_ENG")
 236       ("KCUISUI" "MRXNS_ENG") ("KCUISUI" "MRXW_NONENG")
 237       ("KSRL" "MRDEF") ("KSRL" "MRRANK")
 238       ("KSRL" "MRREL") ("KSRL" "MRSAT") ("KLRL" "MRCOC")
 239       ("KLRL" "MRSTY") ("KLRL" "MRXW_ENG") ("KLRL" "MRXNW_ENG")
 240       ("KLRL" "MRXNS_ENG") ("KLRL" "MRXW_NONENG")
 241       ;; LEX indices
 242       ("EUI" "LRABR") ("EUI2" "LRABR") ("EUI" "LRAGR") ("EUI" "LRCMP") ("EUI" "LRMOD")
 243       ("EUI" "LRNOM") ("EUI2" "LRNOM") ("EUI" "LRPRN") ("EUI" "LRPRP") ("EUI" "LRSPL")
 244       ("EUI" "LRTRM") ("EUI" "LRTYP") ("EUI" "LRWD") ("WRD" "LRWD")
 245       ("BAS" "LRABR")
 246       ;; Semantic NET indices
 247       ("UI" "SRSTRE1") ("UI2" "SRSTRE1") ("UI3" "SRSTRE1")
 248       ("STY_RL" "SRDEF") ("RT" "SRDEF") ("STY_RL" "SRSTR") ("STY_RL2" "SRSTR")
 249       ("RL" "SRSTR")
 250
 251       ("SRL" "MRSAB") ("RSAB" "MRSAB") ("VSAB" "MRSAB") ("RCUI" "MRSAB")
 252       ("VCUI" "MRSAB") ("LAT" "MRSAB") ("MAPSETCUI" "MRMAP")  ("MAPSETCUI" "MRSMAP")
 253       ("CUI" "MRHIER"))
 254   "Columns in files to index")
 255
 256
 257 (defparameter +custom-index-cols+
 258   nil
 259   #+ignore
 260   '(("CUI" "KCON") ("LRL" "KCON"))
 261   "Indexes to custom tables")
 262
 263 ;; File & Column functions
 264
 265 (defun gen-ucols ()
 266   (add-ucols (gen-ucols-meta))
 267   (add-ucols (gen-ucols-custom))
 268   (add-ucols (gen-ucols-generic "LRFLD"))
 269   (add-ucols (gen-ucols-generic "SRFLD")))
 270
 271 (defun gen-ucols-meta ()
 272 "Initialize all umls columns"
 273   (let ((cols '()))
 274     (with-umls-file (line "MRCOLS.RRF")
 275       (destructuring-bind (col des ref min av max fil dty) line
 276         (push (make-ucol col des ref (parse-integer min) (read-from-string av)
 277                          (parse-integer max) fil dty)
 278               cols)))
 279     (nreverse cols)))
 280
 281 (defun gen-ucols-custom ()
 282 "Initialize umls columns for custom columns"
 283   (loop for customcol in +custom-cols+
 284         collect
 285         (make-ucol (nth 1 customcol) "" 0 0 0 (eval (nth 3 customcol))
 286                    (nth 0 customcol) nil :sqltype (canonicalize-column-type (nth 2 customcol))
 287                    :custom-value-fun (nth 4 customcol))))
 288
 289 (defun gen-ucols-generic (col-filename)
 290 "Initialize for generic (LEX/NET) columns"
 291   (let ((cols '()))
 292     (with-umls-file (line col-filename)
 293       (destructuring-bind (nam des ref fil) line
 294         (setq nam (escape-column-name nam))
 295         (dolist (file (delimited-string-to-list fil #\,))
 296           (push
 297            (make-ucol nam des ref nil nil nil file nil)
 298            cols))))
 299     (nreverse cols)))
 300
 301
 302 (defun gen-ufiles ()
 303   (add-ufiles (gen-ufiles-generic "MRFILES.RRF" "META"))
 304   (add-ufiles (gen-ufiles-generic "LRFIL" "LEX"))
 305   (add-ufiles (gen-ufiles-generic "SRFIL" "NET"))
 306   ;; needs to come last
 307   (add-ufiles (gen-ufiles-custom)))
 308
 309
 310 (defun gen-ufiles-generic (files-filename dir)
 311 "Initialize all LEX file structures"
 312   (let ((files '()))
 313     (with-umls-file (line files-filename)
 314       (destructuring-bind (fil des fmt cls rws bts) line
 315         (push (make-ufile
 316                dir fil des
 317                (parse-integer cls)
 318                (parse-integer rws) (parse-integer bts)
 319                (concatenate 'list (umls-field-string-to-list fmt)
 320                             (custom-colnames-for-filename fil)))
 321               files)))
 322     (nreverse files)))
 323
 324 (defun gen-ufiles-custom ()
 325   (make-ufile "META" "MRXW_NONENG.RRF" "Custom NonEnglish Index"
 326               5 0 0 (fields (find-ufile "MRXW_ENG.RRF"))))
 327
 328
 329