r11156: fix trans extension for sbcl, fix index for mrrel

diff --git a/create-sql.lisp b/create-sql.lisp
index f2762861637a5422dc055db70f43fecc5bbaf844..4a4413a1aa2e93e7f1f4431c7fb6ed66fedbfcf2 100644 (file)
--- a/create-sql.lisp
+++ b/create-sql.lisp
@@ -169,6 +169,8 @@
             (:oracle "NUMBER(2,0)")
             (t "INTEGER")))
    :database conn)
+  ;; KCON deprecated by KPFENG field in MRCONSO
+  #+nil
   (dolist (tuple (query "select distinct cui from MRCONSO order by cui"
                        :database conn))
     (let ((cui (car tuple)))
@@ -240,7 +242,7 @@
     (sql-create-indexes conn +custom-index-cols+)
     (sql-create-special-tables conn)))
 
-(defun create-umls-db (&key (extension ".trans") (skip-translation nil))
+(defun create-umls-db (&key (extension "-trans") (skip-translation nil))
   "SQL Databases: initializes entire database via SQL copy commands.
 This is much faster that using create-umls-db-insert."
   (ensure-ucols+ufiles)
@@ -262,7 +264,7 @@ This is much faster that using create-umls-db-insert."
       (sql-create-indexes conn +custom-index-cols+)
       (sql-create-special-tables conn))))
 
-(defun translate-all-files (&optional (extension ".trans"))
+(defun translate-all-files (&optional (extension "-trans"))
   "Copy translated files and return postgresql copy commands to import"
   (make-noneng-index-file extension)
   (dolist (f (remove "MRXW_NONENG.RRF" *umls-files* :test #'string= :key #'fil))
@@ -345,13 +347,13 @@ This is much faster that using create-umls-db-insert."
    nil "COPY ~a FROM '~a' using delimiters '|' with null as ''"
    (table file) (ufile-pathname file extension)))
 
-(defun mysql-copy-cmd (file extension &key local-file)
+(defun mysql-copy-cmd (file extension &key (local-file t))
   "Return mysql copy statement for a file"
   (format
    nil
    "LOAD DATA ~AINFILE \"~a\" INTO TABLE ~a FIELDS TERMINATED BY \"|\""
    (if local-file "LOCAL " "")
-   (ufile-pathname file extension) (table file)))
+   (namestring (ufile-pathname file extension)) (table file)))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

diff --git a/parse-common.lisp b/parse-common.lisp
index ba7aef61c816e8b8d4bf6897254dcfefabe9efc1..25d3ee3f11bc0dff11d8d1083dcb5a8bba3911ae 100644 (file)
--- a/parse-common.lisp
+++ b/parse-common.lisp
@@ -45,10 +45,16 @@
 (defun ufile-pathname (ufile &optional (extension ""))
   "Return pathname for a umls filename with an optional extension"
   (assert (typep ufile 'ufile))
-  (let ((dirs (append (list (dir ufile))
-                     (awhen (subdir ufile) (list it)))))
+  (let* ((dirs (append (list (dir ufile))
+                       (awhen (subdir ufile) (list it))))
+         (name-list (delimited-string-to-list (fil ufile) #\.))
+         (name (if (second name-list)
+                   (first name-list)
+                   (concatenate 'string (first name-list) (or extension ""))))
+         (type (when (second name-list)
+                 (concatenate 'string (second name-list) (or extension "")))))
      (merge-pathnames
-      (make-pathname :name (concatenate 'string (fil ufile) extension)
+      (make-pathname :name name :type type
                     :directory (cons :relative dirs))
       *umls-path*)))
 

diff --git a/parse-rrf.lisp b/parse-rrf.lisp
index 2e744ad9764cc5979c2234977002f5729aba108d..ad9105aa546ee2b9e33b5cfbddbb5d6c879b5d4b 100644 (file)
--- a/parse-rrf.lisp
+++ b/parse-rrf.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; Name:     parse-2002.lisp
+;;;; Name:     parse-rrf.lisp
 ;;;; Purpose:  Parsing and SQL insertion routines for UMLisp which may
 ;;;;           change from year to year
 ;;;; Author:   Kevin M. Rosenberg
@@ -40,11 +40,11 @@
           (clrhash cuisui-lrl-hash)
           (clrhash sab-srl-hash))
       (setf
-         pfstr-hash (make-hash-table :size 800000)
-         cui-lrl-hash (make-hash-table :size 800000)
-         lui-lrl-hash (make-hash-table :size 1500000)
-         sui-lrl-hash (make-hash-table :size 1500000)
-         cuisui-lrl-hash (make-hash-table :size 1800000)
+         pfstr-hash (make-hash-table :size 1300000)
+         cui-lrl-hash (make-hash-table :size 1300000)
+         lui-lrl-hash (make-hash-table :size 4600000)
+         sui-lrl-hash (make-hash-table :size 5100000)
+         cuisui-lrl-hash (make-hash-table :size 2000000)
          sab-srl-hash (make-hash-table :size 100 :test 'equal))))
 
   (defun ensure-preparse (&optional (force-read nil))
@@ -57,10 +57,12 @@
             (sui (parse-ui (nth 5 line)))
             (sab (nth 11 line))
             (srl (parse-integer (nth 15 line))))
+        ;; pfstr deprecated by KPKENG field in MRCONSO
+        #+nil
         (unless (gethash cui pfstr-hash)  ;; if haven't stored pfstr for cui
-            (if (and (string-equal (nth 1 line) "ENG") ; LAT
-                     (string-equal (nth 2 line) "P") ; ts
-                     (string-equal (nth 4 line) "PF")) ; stt
+            (when (and (string-equal (nth 1 line) "ENG") ; LAT
+                       (string-equal (nth 2 line) "P") ; ts
+                       (string-equal (nth 4 line) "PF")) ; stt
              (setf (gethash cui pfstr-hash) (nth 14 line))))
         (set-lrl-hash cui srl cui-lrl-hash)
         (set-lrl-hash lui srl lui-lrl-hash)
@@ -73,7 +75,7 @@
     (setq *preparse-hash-init?* t)
     t)
 
-  (defun pfstr-hash (cui) (gethash cui pfstr-hash))
+  #+nil (defun pfstr-hash (cui) (gethash cui pfstr-hash))
   (defun cui-lrl (cui)    (gethash cui cui-lrl-hash))
   (defun lui-lrl (lui)    (gethash lui lui-lrl-hash))
   (defun sui-lrl (sui)    (gethash sui sui-lrl-hash))
@@ -214,7 +216,7 @@
       ("SCUI" "MRCONSO")
       ("CUI" "MRDEF")
       ("CUI1" "MRREL") ("CUI2" "MRREL")
-      ("RUI" "MRREL") ("AUI" "MRREL") ("AUI2" "MRREL")
+      ("RUI" "MRREL") ("AUI1" "MRREL") ("AUI2" "MRREL")
       ("CUI" "MRSAT") ("LUI" "MRSAT") ("SUI" "MRSAT")
       ("METAUI" "MRSAT") ("ATN" "MRSAT")
       ("CUI" "MRSTY")  ("TUI" "MRSTY") ("CUI" "MRXNS_ENG")