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