(defun create-table-cmd (file)
"Return sql command to create a table"
(let ((col-func
- (lambda (c)
- (let ((sqltype (sqltype c)))
- (case *umls-sql-type*
- (:oracle
- (cond
- ((string-equal sqltype "VARCHAR")
- (setq sqltype "VARCHAR2"))
- ((string-equal sqltype "BIGINT")
- (setq sqltype "VARCHAR2(20)")))))
-
- (concatenate 'string
- (col c)
- " "
- (if (or (string-equal sqltype "VARCHAR")
- (string-equal sqltype "CHAR"))
- (format nil "~a (~a)" sqltype (cmax c))
- sqltype))))))
+ (lambda (c)
+ (let ((sqltype (sqltype c)))
+ (case *umls-sql-type*
+ (:oracle
+ (cond
+ ((string-equal sqltype "VARCHAR")
+ (setq sqltype "VARCHAR2"))
+ ((string-equal sqltype "BIGINT")
+ (setq sqltype "VARCHAR2(20)")))))
+
+ (concatenate 'string
+ (col c)
+ " "
+ (if (or (string-equal sqltype "VARCHAR")
+ (string-equal sqltype "CHAR"))
+ (format nil "~a (~a)" sqltype (cmax c))
+ sqltype))))))
(format nil "CREATE TABLE ~a (~{~a~^,~})~A~A"
- (table file)
- (mapcar col-func (ucols file))
- (if (and (eq *umls-sql-type* :mysql)
- (string-equal (table file) "MRCXT"))
- " MAX_ROWS=200000000"
- "")
- (if (eq *umls-sql-type* :mysql)
- " TYPE=MYISAM CHARACTER SET utf8"
- ""))))
+ (table file)
+ (mapcar col-func (ucols file))
+ (if (and (eq *umls-sql-type* :mysql)
+ (string-equal (table file) "MRCXT"))
+ " MAX_ROWS=200000000"
+ "")
+ (if (eq *umls-sql-type* :mysql)
+ " TYPE=MYISAM CHARACTER SET utf8"
+ ""))))
(defun create-custom-table-cmd (tablename sql-cmd)
"Return SQL command to create a custom table"
(defun insert-values-cmd (file values)
"Return sql insert command for a row of values"
(let ((insert-func
- (lambda (col value)
- (concatenate 'string (quote-str col)
- (insert-col-value col value)
- (quote-str col)))))
+ (lambda (col value)
+ (concatenate 'string (quote-str col)
+ (insert-col-value col value)
+ (quote-str col)))))
(format
nil "INSERT INTO ~a (~{~a~^,~}) VALUES (~A)"
(table file)
(defun custom-col-value (col values doquote)
(let ((custom-value (funcall (custom-value-fun col) values)))
(if custom-value
- (if doquote
- (concatenate 'string (quote-str col)
- (escape-backslashes custom-value)
- (quote-str col))
- (escape-backslashes custom-value))
- "")))
+ (if doquote
+ (concatenate 'string (quote-str col)
+ (escape-backslashes custom-value)
+ (quote-str col))
+ (escape-backslashes custom-value))
+ "")))
(defun custom-col-values (ucols values doquote)
"Returns a list of string column values for SQL inserts for custom columns"
(defun find-custom-col (filename col)
(find-if (lambda (x) (and (string-equal filename (car x))
- (string-equal col (cadr x)))) +custom-cols+))
+ (string-equal col (cadr x)))) +custom-cols+))
(defun custom-colnames-for-filename (filename)
(mapcar #'cadr (find-custom-cols-for-filename filename)))
(defun noneng-lang-index-files ()
(remove-if-not
(lambda (f) (and (> (length (fil f)) 4)
- (string-equal (fil f) "MRXW_" :end1 5)
- (not (string-equal (fil f) "MRXW_ENG.RRF"))
- (not (string-equal (fil f) "MRXW_NONENG.RRF"))))
+ (string-equal (fil f) "MRXW_" :end1 5)
+ (not (string-equal (fil f) "MRXW_ENG.RRF"))
+ (not (string-equal (fil f) "MRXW_NONENG.RRF"))))
*umls-files*))
;;; SQL Command Functions
(defun create-index-cmd (colname tablename length)
"Return sql create index command"
(format nil "CREATE INDEX ~a ON ~a (~a)"
- (concatenate 'string tablename "_" colname "_X")
- tablename
- (case *umls-sql-type*
- (:mysql
- (concatenate 'string colname
- (if (integerp length)
- (format nil " (~d)" length)
- "")))
- ((:postgresql :postgresql-socket)
- ;; FIXME: incorrect syntax for postgresql?
- (if (integerp length)
- (format nil "substr((~A)::text,1,~D)" colname length)
- colname))
- (t
- colname))))
+ (concatenate 'string tablename "_" colname "_X")
+ tablename
+ (case *umls-sql-type*
+ (:mysql
+ (concatenate 'string colname
+ (if (integerp length)
+ (format nil " (~d)" length)
+ "")))
+ ((:postgresql :postgresql-socket)
+ ;; FIXME: incorrect syntax for postgresql?
+ (if (integerp length)
+ (format nil "substr((~A)::text,1,~D)" colname length)
+ colname))
+ (t
+ colname))))
(defun create-all-tables-cmdfile ()
"Return sql commands to create all tables. Not need for automated SQL import"
(ignore-errors (execute-command "DROP TABLE KCON" :database conn))
(execute-command
(format nil "CREATE TABLE KCON (CUI INTEGER, STR ~A, LRL ~A)"
- (case *umls-sql-type*
- (:oracle
- (format nil "VARCHAR2(~D)"
- (slot-value (find-ucol "STR" "MRCONSO.RRF") 'max)))
- (t "TEXT"))
- (case *umls-sql-type*
- (:mysql "TINYINT")
- ((:postgresql :postgresql-socket) "INT2")
- (:oracle "NUMBER(2,0)")
- (t "INTEGER")))
+ (case *umls-sql-type*
+ (:oracle
+ (format nil "VARCHAR2(~D)"
+ (slot-value (find-ucol "STR" "MRCONSO.RRF") 'max)))
+ (t "TEXT"))
+ (case *umls-sql-type*
+ (:mysql "TINYINT")
+ ((:postgresql :postgresql-socket) "INT2")
+ (: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))
+ :database conn))
(let ((cui (car tuple)))
(execute-command
(format nil "INSERT into KCON VALUES (~D,'~A',~D)"
- cui
- (add-sql-quotes (pfstr-hash cui) )
- (cui-lrl cui))
+ cui
+ (add-sql-quotes (pfstr-hash cui) )
+ (cui-lrl cui))
:database conn))))
(defun sql-create-custom-tables (conn)
(case *umls-sql-type*
(:mysql
(format nil "DROP INDEX ~a ON ~a"
- (concatenate 'string tablename "_" colname "_X")
- tablename))
+ (concatenate 'string tablename "_" colname "_X")
+ tablename))
(t
(format nil "DROP INDEX ~a"
- (concatenate 'string tablename "_" colname "_X")))))
+ (concatenate 'string tablename "_" colname "_X")))))
(defun sql-create-indexes (conn &key (indexes +index-cols+) verbose)
"SQL Databases: create all indexes"
(ignore-errors (sql-execute "drop table USRL" conn)))
(sql-execute "create table USRL (sab varchar(80), srl integer)" conn)
(dolist (tuple (mutex-sql-query
- "select distinct SAB,SRL from MRCONSO order by SAB asc"))
+ "select distinct SAB,SRL from MRCONSO order by SAB asc"))
(sql-execute (format nil "insert into USRL (sab,srl) values ('~a',~d)"
- (car tuple) (ensure-integer (cadr tuple)))
- conn)))
+ (car tuple) (ensure-integer (cadr tuple)))
+ conn)))
(defun sql-create-special-tables (conn)
(make-usrl conn)
(when verbose (format t "UMLS Import: Converting text UMLS files to optimized format.~%"))
(translate-all-files :extension extension :verbose verbose :force force-translation)
(let ((copy-cmd
- (ecase (umls-sql-type)
- (:mysql #'mysql-copy-cmd)
- (:postgresql #'pg-copy-cmd))))
+ (ecase (umls-sql-type)
+ (:mysql #'mysql-copy-cmd)
+ (:postgresql #'pg-copy-cmd))))
(with-sql-connection (conn)
(clsql:truncate-database :database conn)
(sql-drop-tables conn)
(sql-create-tables conn)
(dolist (file *umls-files*)
(when verbose (format t "UMLS Import: Importing file ~A to SQL.~%" (fil file)))
- (sql-execute (funcall copy-cmd file extension) conn))
+ (sql-execute (funcall copy-cmd file extension) conn))
(When verbose (format t "UMLS Import: Creating SQL indices.~%"))
(sql-create-indexes conn :verbose verbose)
(When verbose (format t "UMLS Import: Creating custom tables.~%"))
(defun translate-all-files (&key (extension "-trans") verbose force)
"Translate all *umls-files* to optimized import format."
- (make-noneng-index-file extension)
+ (when verbose (format t "UMLS Import: Translating file ~A.~%" (fil (find-ufile "MRXW_NONENG.RRF"))))
+ (make-noneng-index-file extension :force force)
(dolist (f (remove "MRXW_NONENG.RRF" *umls-files* :test #'string= :key #'fil))
(when verbose (format t "UMLS Import: Translating file ~A.~%" (fil f)))
(translate-umls-file f extension :force force)))
(defun make-noneng-index-file (extension &key force)
"Make non-english index file"
(translate-files (find-ufile "MRXW_NONENG.RRF")
- extension (noneng-lang-index-files) :force force))
+ extension (noneng-lang-index-files) :force force))
(defun verify-translation-file (output-path input-ufiles)
"Returns t if translation file exists and is correct size. Warns and deletes incomplete translation file."
(return-from translate-files output-path))
(with-open-file (ostream output-path :direction :output
:if-exists :overwrite
+ :if-does-not-exist :create
#+(and clisp unicode) :external-format
#+(and clisp unicode) charset:utf-8)
(dolist (input-ufile input-ufiles)
(defun translate-line (file line strm)
"Translate a single line for sql output"
(flet ((col-value (col value)
- (if (eq (datatype col) 'sql-u)
- (let ((ui (parse-ui value "")))
- (if (stringp ui)
- ui
- (write-to-string ui)))
- (escape-backslashes value))))
+ (if (eq (datatype col) 'sql-u)
+ (let ((ui (parse-ui value "")))
+ (if (stringp ui)
+ ui
+ (write-to-string ui)))
+ (escape-backslashes value))))
(print-separated-strings
strm "|"
(mapcar #'col-value (remove-custom-cols (ucols file)) line)
"Return mysql copy statement for a file"
(format
nil
- "LOAD DATA ~AINFILE \"~a\" INTO TABLE ~a FIELDS TERMINATED BY \"|\""
+ "LOAD DATA ~AINFILE '~a' INTO TABLE ~a FIELDS TERMINATED BY '|'"
(if local-file "LOCAL " "")
(namestring (ufile-pathname file extension)) (table file)))
(defun umls-fixed-size-waste ()
"Display storage waste if using all fixed size storage"
(let ((totalwaste 0)
- (totalunavoidable 0)
- (totalavoidable 0)
- (unavoidable '())
- (avoidable '()))
+ (totalunavoidable 0)
+ (totalavoidable 0)
+ (unavoidable '())
+ (avoidable '()))
(dolist (file *umls-files*)
(dolist (col (ucols file))
- (let* ((avwaste (- (cmax col) (av col)))
- (cwaste (* avwaste (rws file))))
- (when (plusp cwaste)
- (if (<= avwaste 6)
- (progn
- (incf totalunavoidable cwaste)
- (push (list (fil file) (col col)
- avwaste cwaste)
- unavoidable))
- (progn
- (incf totalavoidable cwaste)
- (push (list (fil file) (col col)
- avwaste cwaste)
- avoidable)))
- (incf totalwaste cwaste)))))
+ (let* ((avwaste (- (cmax col) (av col)))
+ (cwaste (* avwaste (rws file))))
+ (when (plusp cwaste)
+ (if (<= avwaste 6)
+ (progn
+ (incf totalunavoidable cwaste)
+ (push (list (fil file) (col col)
+ avwaste cwaste)
+ unavoidable))
+ (progn
+ (incf totalavoidable cwaste)
+ (push (list (fil file) (col col)
+ avwaste cwaste)
+ avoidable)))
+ (incf totalwaste cwaste)))))
(values totalwaste totalavoidable totalunavoidable
- (nreverse avoidable) (nreverse unavoidable))))
+ (nreverse avoidable) (nreverse unavoidable))))
(defun display-waste ()
(ensure-ucols+ufiles)
(declare (type (integer 0 1000000) max))
(dolist (ucol *umls-cols*)
(when (> (the (integer 0 1000000) (cmax ucol)) max)
- (setq max (cmax ucol))))
+ (setq max (cmax ucol))))
max))
(defun max-umls-row ()
(dolist (file *umls-files*)
(let ((row 0))
(declare (type (integer 0 1000000) row))
- (dolist (ucol (ucols file))
+ (dolist (ucol (ucols file))
(let* ((col-max (cmax ucol))
(max-with-delim (1+ col-max)))
(declare (type (integer 0 1000000) col-max max-with-delim))
(incf row max-with-delim)))
- (push row rowsizes)))
+ (push row rowsizes)))
(car (sort rowsizes #'>))))
projects / umlisp.git / blobdiff