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: parse-2002.lisp,v 1.15 2003/07/21 00:53:27 kevin Exp $
  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
 126 (defparameter +col-datatypes+
 127     '(("AV" sql-f) ("BTS" sql-i) ("CLS" sql-i) ("COF" sql-i) ("CUI1" sql-u)
 128       ("CUI2" sql-u) ("CUI" sql-u) ("CXN" sql-s) ("FR" sql-i) ("LRL" sql-s)
 129       ("LUI" sql-u) ("MAX" sql-s) ("MIN" sql-s) ("RANK" sql-s) ("REF" sql-s)
 130       ("RNK" sql-s) ("RWS" sql-i) ("SRL" sql-s) ("SUI" sql-u) ("TUI" sql-u)
 131       ;;; Custom columns
 132       ("KCUISUI" sql-l) ("KCUILUI" sql-l) ("KCUILRL" sql-i) ("KLUILRL" sql-i)
 133       ("KSRL" sql-i) ("KLRL" sql-i)
 134       ;;; LEX columns
 135       ("EUI" sql-u) ("EUI2" sql-u)
 136       ;;; Semantic net columns
 137       ("UI" sql-u) ("UI2" sql-u) ("UI3" sql-u)
 138       ;; New fields for 2002AD
 139       ("RCUI" sql-u) ("VCUI" sql-u) ("CFR" sql-i) ("TFR" sql-i)
 140       )
 141     "SQL data types for each non-string column")
 142
 143 (defparameter +custom-tables+
 144     nil
 145   #+ignore
 146   '(("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")
 147     ("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"))
 148   "Custom tables to create")
 149
 150 (defparameter +custom-cols+
 151     '(("MRCON" "KPFSTR" "TEXT" 1024
 152                (lambda (x) (pfstr-hash (parse-ui (nth 0 x)))))
 153       ("MRCON" "KCUISUI" "BIGINT" 0
 154        (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 5 x))))))
 155       ("MRCON" "KCUILUI" "BIGINT" 0
 156        (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 3 x))))))
 157       ("MRCON" "KCUILRL" "INTEGER" 0
 158        (lambda (x) (write-to-string (cui-lrl (parse-ui (nth 0 x))))))
 159       ("MRCON" "KLUILRL" "INTEGER" 0
 160        (lambda (x) (write-to-string (lui-lrl (parse-ui (nth 3 x))))))
 161       ("MRLO" "KLRL" "INTEGER" 0
 162        (lambda (x) (write-to-string
 163                     (if (zerop (length (nth 4 x)))
 164                         (cui-lrl (parse-ui (nth 0 x)))
 165                       (cuisui-lrl (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 4 x))))))))
 166       ("MRSTY" "KLRL" "INTEGER" 0
 167        (lambda (x) (write-to-string (cui-lrl (parse-ui (nth 0 x))))))
 168       ("MRCOC" "KLRL" "INTEGER" 0
 169        (lambda (x) (write-to-string
 170                     (max (cui-lrl (parse-ui (nth 0 x)))
 171                          (kmrcl:aif (cui-lrl (parse-ui (nth 1 x))) kmrcl::it 0)))))
 172       ("MRSAT" "KSRL" "INTEGER" 0
 173        (lambda (x) (write-to-string (sab-srl (nth 5 x)))))
 174       ("MRREL" "KSRL" "INTEGER" 0
 175        (lambda (x) (write-to-string (sab-srl (nth 4 x)))))
 176       ("MRRANK" "KSRL" "INTEGER" 0
 177        (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
 178       ("MRDEF" "KSRL" "INTEGER" 0
 179        (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
 180       ("MRCXT" "KSRL" "INTEGER" 0
 181        (lambda (x) (write-to-string (sab-srl (nth 2 x)))))
 182       ("MRATX" "KSRL" "INTEGER" 0
 183        (lambda (x) (write-to-string (sab-srl (nth 1 x)))))
 184       ("MRXW.ENG" "KLRL" "INTEGER" 0
 185        (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
 186                                                  (parse-ui (nth 2 x))
 187                                                  (parse-ui (nth 4 x)))))))
 188       ("MRXW.NONENG" "KLRL" "INTEGER" 0
 189        (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
 190                                                  (parse-ui (nth 2 x))
 191                                                  (parse-ui (nth 4 x)))))))
 192       ("MRXNW.ENG" "KLRL" "INTEGER" 0
 193        (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
 194                                                  (parse-ui (nth 2 x))
 195                                                  (parse-ui (nth 4 x)))))))
 196       ("MRXNS.ENG" "KLRL" "INTEGER" 0
 197        (lambda (x) (write-to-string (cuisui-lrl (make-cuisui
 198                                                  (parse-ui (nth 2 x))
 199                                                  (parse-ui (nth 4 x)))))))
 200       ("MRREL" "KPFSTR2" "TEXT" 1024
 201        (lambda (x) (pfstr-hash (parse-ui (nth 2 x)))))
 202       ("MRCOC" "KPFSTR2" "TEXT" 1024
 203        (lambda (x) (pfstr-hash (parse-ui (nth 1 x)))))
 204       ("MRCXT" "KCUISUI" "BIGINT" 0
 205        (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 1 x))))))
 206       ("MRSAT" "KCUILUI" "BIGINT" 0
 207        (lambda (x) (write-to-string (make-cuilui (parse-ui (nth 0 x)) (parse-ui (nth 1 x))))))
 208       ("MRSAT" "KCUISUI" "BIGINT" 0
 209        (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 2 x))))))
 210       ("MRSO" "KCUISUI" "BIGINT" 0
 211        (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 0 x)) (parse-ui (nth 2 x))))))
 212       ("MRXW.ENG" "KCUISUI" "BIGINT" 0
 213        (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))
 214       ("MRXNW.ENG" "KCUISUI" "BIGINT" 0
 215        (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))
 216       ("MRXNS.ENG" "KCUISUI" "BIGINT" 0
 217        (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x))))))
 218       ("MRXW.NONENG" "LAT" "CHAR" 3 (lambda (x) (nth 0 x)))
 219       ("MRXW.NONENG" "WD"  "CHAR" 200  (lambda (x) (nth 1 x)))
 220       ("MRXW.NONENG" "CUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 2 x)))))
 221       ("MRXW.NONENG" "LUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 3 x)))))
 222       ("MRXW.NONENG" "SUI" "INTEGER" 0 (lambda (x) (write-to-string (parse-ui (nth 4 x)))))
 223       ("MRXW.NONENG" "KCUISUI" "BIGINT" 0
 224        (lambda (x) (write-to-string (make-cuisui (parse-ui (nth 2 x)) (parse-ui (nth 4 x)))))))
 225   "Custom columns to create.(filename, col, sqltype, value-func).")
 226
 227 (defparameter +index-cols+
 228     '(("CUI" "MRATX") ("CUI1" "MRCOC") ("CUI" "MRCON") ("LUI" "MRCON")
 229       ("LRL" "MRCON")
 230       ("SUI" "MRCON") ("CUI" "MRCXT") ("CUI" "MRDEF") ("CUI" "MRLO")
 231       ("CUI1" "MRREL") ("CUI" "MRSAT") ("LUI" "MRSAT") ("SUI" "MRSAT")
 232       ("CUI" "MRSO") ("SAB" "MRSO") ("SRL" "MRSO") ("CUI" "MRSTY")
 233       ("TUI" "MRSTY") ("CUI" "MRXNS_ENG") ("NSTR" "MRXNS_ENG" 10)
 234       ("CUI" "MRXNW_ENG") ("NWD" "MRXNW_ENG") ("WD" "MRXW_ENG")
 235       ("KCUISUI" "MRCON") ("KCUILUI" "MRCON") ("KCUILRL" "MRCON")
 236       ("KLUILRL" "MRCON") ("KCUISUI" "MRCXT")
 237       ("KCUISUI" "MRSO") ("KCUISUI" "MRSAT")  ("KCUILUI" "MRSAT")
 238       ("KCUISUI" "MRXW_ENG") ("KCUISUI" "MRXNW_ENG")
 239       ("KCUISUI" "MRXNS_ENG") ("KCUISUI" "MRXW_NONENG")
 240       ("KSRL" "MRATX") ("KSRL" "MRCXT") ("KSRL" "MRDEF") ("KSRL" "MRRANK")
 241       ("KSRL" "MRREL") ("KSRL" "MRSAT") ("KLRL" "MRCOC")
 242       ("KLRL" "MRLO") ("KLRL" "MRSTY") ("KLRL" "MRXW_ENG") ("KLRL" "MRXNW_ENG")
 243       ("KLRL" "MRXNS_ENG") ("KLRL" "MRXW_NONENG")
 244       ;; LEX indices
 245       ("EUI" "LRABR") ("EUI2" "LRABR") ("EUI" "LRAGR") ("EUI" "LRCMP") ("EUI" "LRMOD")
 246       ("EUI" "LRNOM") ("EUI2" "LRNOM") ("EUI" "LRPRN") ("EUI" "LRPRP") ("EUI" "LRSPL")
 247       ("EUI" "LRTRM") ("EUI" "LRTYP") ("EUI" "LRWD") ("WRD" "LRWD")
 248       ("BAS" "LRABR")
 249       ;; Semantic NET indices
 250       ("UI" "SRSTRE1") ("UI2" "SRSTRE1") ("UI3" "SRSTRE1")
 251       ("STY_RL" "SRDEF") ("RT" "SRDEF") ("STY_RL" "SRSTR") ("STY_RL2" "SRSTR")
 252       ("RL" "SRSTR")
 253       ("SRL" "MRSAB") ("RSAB" "MRSAB") ("VSAB" "MRSAB") ("RCUI" "MRSAB")
 254       ("VCUI" "MRSAB") ("LAT" "MRSAB"))
 255   "Columns in files to index")
 256
 257
 258 (defparameter +custom-index-cols+
 259   nil
 260   #+ignore
 261   '(("CUI" "MRCONFULL") ("SAB" "MRCONFULL") ("TUI" "MRCONFULL"))
 262   "Indexes to custom tables")
 263
 264 ;; File & Column functions
 265
 266 (defun gen-ucols ()
 267   (add-ucols (gen-ucols-meta))
 268   (add-ucols (gen-ucols-custom))
 269   (add-ucols (gen-ucols-generic "LRFLD"))
 270   (add-ucols (gen-ucols-generic "SRFLD")))
 271
 272 (defun gen-ucols-meta ()
 273 "Initialize all umls columns"
 274   (let ((cols '()))
 275     (with-umls-file (line "MRCOLS")
 276       (destructuring-bind (col des ref min av max fil dty) line
 277         (push (make-ucol col des ref (parse-integer min) (read-from-string av)
 278                          (parse-integer max) fil dty)
 279               cols)))
 280     (nreverse cols)))
 281
 282 (defun gen-ucols-custom ()
 283 "Initialize umls columns for custom columns"
 284   (loop for customcol in +custom-cols+
 285         collect
 286         (make-ucol (nth 1 customcol) "" 0 0 0 (nth 3 customcol)
 287                    (nth 0 customcol) nil :sqltype (nth 2 customcol)
 288                    :custom-value-fun (nth 4 customcol))))
 289
 290 (defun gen-ucols-generic (col-filename)
 291 "Initialize for generic (LEX/NET) columns"
 292   (let ((cols '()))
 293     (with-umls-file (line col-filename)
 294       (destructuring-bind (nam des ref fil) line
 295         (setq nam (escape-column-name nam))
 296         (dolist (file (delimited-string-to-list fil #\,))
 297           (push
 298            (make-ucol nam des ref nil nil nil file nil)
 299            cols))))
 300     (nreverse cols)))
 301
 302
 303 (defun gen-ufiles ()
 304   (add-ufiles (gen-ufiles-generic "MRFILES"))
 305   (add-ufiles (gen-ufiles-generic "LRFIL"))
 306   (add-ufiles (gen-ufiles-generic "SRFIL"))
 307   ;; needs to come last
 308   (add-ufiles (gen-ufiles-custom)))
 309
 310
 311 (defun gen-ufiles-generic (files-filename)
 312 "Initialize all LEX file structures"
 313   (let ((files '()))
 314     (with-umls-file (line files-filename)
 315       (destructuring-bind (fil des fmt cls rws bts) line
 316         (push (make-ufile
 317                fil des (substitute #\_ #\. fil) (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 "MRXW.NONENG" "Custom NonEnglish Index" "MRXW_NONENG"
 326               5 0 0 (fields (find-ufile "MRXW.ENG"))))
 327
 328
 329