parse-rrf.lisp

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