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