create-sql.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:     sql-create
   6 ;;;; Purpose:  Create SQL database for UMLisp
   7 ;;;; Author:   Kevin M. Rosenberg
   8 ;;;; Created:  Apr 2000
   9 ;;;;
  10 ;;;; This file, part of UMLisp, is
  11 ;;;;    Copyright (c) 2000-2010 by Kevin M. Rosenberg, M.D.
  12 ;;;;
  13 ;;;; UMLisp users are granted the rights to distribute and use this software
  14 ;;;; as governed by the terms of the GNU General Public License.
  15 ;;;; *************************************************************************
  16
  17 (in-package #:umlisp)
  18
  19 (defun create-table-cmd (file)
  20   "Return sql command to create a table"
  21   (let ((col-func
  22          (lambda (c)
  23            (let ((sqltype (sqltype c)))
  24              (case *umls-sql-type*
  25                (:oracle
  26                 (cond
  27                  ((string-equal sqltype "VARCHAR")
  28                   (setq sqltype "VARCHAR2"))
  29                  ((string-equal sqltype "BIGINT")
  30                   (setq sqltype "VARCHAR2(20)")))))
  31
  32              (concatenate 'string
  33                (col c)
  34                " "
  35                (if (or (string-equal sqltype "VARCHAR")
  36                        (string-equal sqltype "CHAR"))
  37                    (format nil "~a (~a)" sqltype (cmax c))
  38                  sqltype))))))
  39     (format nil "CREATE TABLE ~a (~{~a~^,~})~A~A"
  40             (table file)
  41             (mapcar col-func (ucols file))
  42             (if (and (eq *umls-sql-type* :mysql)
  43                      (string-equal (table file) "MRCXT"))
  44                 " MAX_ROWS=200000000"
  45               "")
  46             (if (eq *umls-sql-type* :mysql)
  47                 " ENGINE=MYISAM CHARACTER SET utf8 COLLATE utf8_bin"
  48                 ""))))
  49
  50 (defun create-custom-table-cmd (tablename sql-cmd)
  51   "Return SQL command to create a custom table"
  52   (format nil "CREATE TABLE ~a AS ~a;" tablename sql-cmd))
  53
  54 (defun insert-col-value (col value)
  55   (if (null (parse-fun col))
  56       value
  57       (format nil "~A" (funcall (parse-fun col) value))))
  58
  59 (defun insert-values-cmd (file values)
  60   "Return sql insert command for a row of values"
  61   (let ((insert-func
  62          (lambda (col value)
  63            (concatenate 'string (quote-str col)
  64                         (insert-col-value col value)
  65                         (quote-str col)))))
  66     (format
  67      nil "INSERT INTO ~a (~{~a~^,~}) VALUES (~A)"
  68      (table file)
  69      (fields file)
  70      (concat-separated-strings
  71       ","
  72       (mapcar insert-func (remove-custom-cols (ucols file)) values)
  73       (custom-col-values (custom-ucols-for-file file) values t)))))
  74
  75
  76 (defun custom-col-value (col values doquote)
  77   (let ((custom-value (funcall (custom-value-fun col) values)))
  78     (if custom-value
  79         (if doquote
  80             (concatenate 'string (quote-str col)
  81                          (escape-backslashes custom-value)
  82                          (quote-str col))
  83             (escape-backslashes custom-value))
  84         "")))
  85
  86 (defun custom-col-values (ucols values doquote)
  87   "Returns a list of string column values for SQL inserts for custom columns"
  88   (loop for col in ucols collect (custom-col-value col values doquote)))
  89
  90 (defun remove-custom-cols (cols)
  91   "Remove custom cols from a list col umls-cols"
  92   (remove-if #'custom-value-fun cols))
  93
  94 (defun find-custom-cols-for-filename (filename)
  95   (remove-if-not (lambda (x) (string-equal filename (car x))) +custom-cols+))
  96
  97 (defun find-custom-col (filename col)
  98   (find-if (lambda (x) (and (string-equal filename (car x))
  99                             (string-equal col (cadr x)))) +custom-cols+))
 100
 101 (defun custom-colnames-for-filename (filename)
 102   (mapcar #'cadr (find-custom-cols-for-filename filename)))
 103
 104 (defun custom-ucols-for-file (file)
 105   (remove-if-not #'custom-value-fun (ucols file)))
 106
 107 (defun noneng-lang-index-files ()
 108   (remove-if-not
 109    (lambda (f) (and (> (length (fil f)) 4)
 110                     (string-equal (fil f) "MRXW_" :end1 5)
 111                     (not (string-equal (fil f) "MRXW_ENG.RRF"))
 112                     (not (string-equal (fil f) "MRXW_NONENG.RRF"))))
 113    *umls-files*))
 114
 115 ;;; SQL Command Functions
 116
 117 (defun create-index-cmd (colname tablename length)
 118   "Return sql create index command"
 119   (format nil "CREATE INDEX ~a ON ~a (~a)"
 120           (concatenate 'string tablename "_" colname "_X")
 121           tablename
 122           (case *umls-sql-type*
 123             (:mysql
 124              (concatenate 'string colname
 125                           (if (integerp length)
 126                               (format nil " (~d)" length)
 127                               "")))
 128             ((:postgresql :postgresql-socket)
 129              ;; FIXME: incorrect syntax for postgresql?
 130              (if (integerp length)
 131                  (format nil "substr((~A)::text,1,~D)" colname length)
 132                  colname))
 133             (t
 134              colname))))
 135
 136 (defun create-all-tables-cmdfile ()
 137   "Return sql commands to create all tables. Not need for automated SQL import"
 138   (mapcar (lambda (f) (format nil "~a~%~%" (create-table-cmd f))) *umls-files*))
 139
 140 ;; SQL Execution functions
 141
 142 (defun sql-drop-tables (conn)
 143   "SQL Databases: drop all tables"
 144   (dolist (file *umls-files*)
 145     (ignore-errors
 146       (sql-execute (format nil "DROP TABLE ~a" (table file)) conn))))
 147
 148 (defun sql-create-tables (conn)
 149   "SQL Databases: create all tables"
 150   (dolist (file *umls-files*)
 151     (sql-execute (create-table-cmd file) conn)))
 152
 153 #+ignore
 154 (defun sql-create-kcon-table (conn)
 155   "Create concept table, one row per concept."
 156   (ignore-errors (execute-command "DROP TABLE KCON" :database conn))
 157   (execute-command
 158    (format nil "CREATE TABLE KCON (CUI INTEGER, STR ~A, LRL ~A)"
 159            (case *umls-sql-type*
 160              (:oracle
 161               (format nil "VARCHAR2(~D)"
 162                       (slot-value (find-ucol "STR" "MRCONSO.RRF") 'max)))
 163              (t "TEXT"))
 164            (case *umls-sql-type*
 165              (:mysql "TINYINT")
 166              ((:postgresql :postgresql-socket) "INT2")
 167              (:oracle "NUMBER(2,0)")
 168              (t "INTEGER")))
 169    :database conn)
 170   ;; KCON deprecated by KPFENG field in MRCONSO
 171   #+nil
 172   (dolist (tuple (query "select distinct cui from MRCONSO order by cui"
 173                         :database conn))
 174     (let ((cui (car tuple)))
 175       (execute-command
 176        (format nil "INSERT into KCON VALUES (~D,'~A',~D)"
 177                cui
 178                (add-sql-quotes (pfstr-hash cui) )
 179                (cui-lrl cui))
 180        :database conn))))
 181
 182 (defun sql-create-custom-tables (conn)
 183   "SQL Databases: create all custom tables"
 184   ;;(sql-create-kcon-table conn)
 185   (dolist (ct +custom-tables+)
 186     (sql-execute (create-custom-table-cmd (car ct) (cadr ct)) conn)))
 187
 188 (defun sql-insert-values (conn file)
 189   "SQL Databases: inserts all values for a file"
 190   (with-umls-file (line (fil file))
 191     (sql-execute (insert-values-cmd file line) conn)))
 192
 193 (defun sql-insert-all-values (conn)
 194   "SQL Databases: inserts all values for all files"
 195   (dolist (file *umls-files*)
 196     (sql-insert-values conn file)))
 197
 198 (defun drop-index-cmd (colname tablename)
 199   "Return sql create index command"
 200   (case *umls-sql-type*
 201     (:mysql
 202      (format nil "DROP INDEX ~a ON ~a"
 203              (concatenate 'string tablename "_" colname "_X")
 204              tablename))
 205     (t
 206      (format nil "DROP INDEX ~a"
 207              (concatenate 'string tablename "_" colname "_X")))))
 208
 209 (defun sql-create-indexes-mysql (conn indexes verbose)
 210   (let ((tables nil)
 211         (table-cols nil))
 212     (dolist (idx indexes)
 213       (pushnew (second idx) tables :test 'string-equal)
 214       (let ((table-col (find (second idx) table-cols :key 'car :test 'string-equal)))
 215         (if table-col
 216             (vector-push-extend (cons (first idx) (third idx)) (second table-col))
 217             (push (list (second idx) (make-array (list 1) :initial-contents (list (cons (first idx) (third idx)))
 218                                                  :adjustable t :fill-pointer 1))
 219                   table-cols))))
 220     (dolist (table tables)
 221       (let ((table-col (find table table-cols :key 'car :test 'string-equal))
 222             (first t)
 223             (str (format nil "ALTER TABLE ~A" table)))
 224         (loop for col across (second table-col)
 225            do
 226              (let ((colname (car col))
 227                    (length (cdr col)))
 228                (ignore-errors (sql-execute (drop-index-cmd colname table) conn))
 229                (setq str (concatenate 'string
 230                                       str
 231                                       (if first
 232                                           (progn
 233                                             (setq first nil)
 234                                             " ")
 235                                           ", ")
 236                                       (format nil "ADD INDEX ~A (~A)"
 237                                               (concatenate 'string table "_" colname "_X")
 238                                               (concatenate 'string
 239                                                            colname
 240                                                            (if (integerp length)
 241                                                                (format nil " (~d)" length)
 242                                                                "")))))))
 243         (when verbose
 244           (format t "UMLS Import: Creating indexes for columns ~A on table ~A.~%"
 245                   (mapcar 'car (coerce (second table-col) 'list)) table))
 246         (when conn
 247           (sql-execute str conn))
 248         ))))
 249
 250 (defun sql-create-indexes (conn &key (indexes +index-cols+) verbose)
 251   "SQL Databases: create all indexes"
 252   (if (eql :mysql *umls-sql-type*)
 253       (sql-create-indexes-mysql conn indexes verbose)
 254       (dolist (idx indexes)
 255         (when verbose (format t "UMLS Import: Creating index for column ~A on table ~A.~%"
 256                               (first idx) (second idx)))
 257         (ignore-errors (sql-execute (drop-index-cmd (car idx) (cadr idx)) conn))
 258         (sql-execute (create-index-cmd (car idx) (cadr idx) (caddr idx)) conn))))
 259
 260 (defun make-usrl (conn)
 261   (if (eql :mysql *umls-sql-type*)
 262       (sql-execute "drop table if exists USRL" conn)
 263       (ignore-errors (sql-execute "drop table USRL" conn)))
 264   (sql-execute
 265    (concatenate 'string
 266                 "create table USRL (sab varchar(80), srl integer)"
 267                 (if (eq *umls-sql-type* :mysql)
 268                     " ENGINE=MYISAM CHARACTER SET utf8 COLLATE utf8_bin"
 269                     ""))
 270    conn)
 271   (dolist (tuple (mutex-sql-query
 272                   "select distinct SAB,SRL from MRCONSO order by SAB asc"))
 273     (sql-execute (format nil "insert into USRL (sab,srl) values ('~a',~d)"
 274                          (car tuple) (ensure-integer (cadr tuple)))
 275                  conn)))
 276
 277 (defun make-ustats (conn)
 278   (ignore-errors (sql-execute "drop table USTATS" conn))
 279   (sql-execute
 280    (concatenate 'string"create table USTATS (NAME varchar(160), COUNT bigint, SRL integer)"
 281                 (if (eq *umls-sql-type* :mysql)
 282                     " ENGINE=MYISAM CHARACTER SET utf8 COLLATE utf8_bin"
 283                     ""))
 284    conn)
 285
 286   (dolist (srl '(0 1 2 3 4 9))
 287     (insert-ustats-count conn "Concept Count" "MRCONSO" "distinct CUI" "KCUILRL" srl)
 288     (insert-ustats-count conn "Term Count" "MRCONSO" "distinct KCUILUI" "KCUILRL" srl)
 289     (insert-ustats-count conn "Distinct Term Count" "MRCONSO" "distinct LUI" "KLUILRL" srl)
 290     (insert-ustats-count conn "String Count" "MRCONSO" "*" "KSUILRL" srl)
 291     (insert-ustats-count conn "Distinct String Count" "MRCONSO" "distinct SUI" "KSUILRL" srl)
 292     (insert-ustats-count conn "Hierarchcy" "MRHIER" "*" "KSRL" srl)
 293     (insert-ustats-count conn "Mappings" "MRMAP" "*" "KSRL" srl)
 294     (insert-ustats-count conn "Simple Mappings" "MRSMAP" "*" "KSRL" srl)
 295 #+mrcoc (insert-ustats-count conn "Co-occuring Concept Count" "MRCOC" "*" "KLRL" srl)
 296     (insert-ustats-count conn "Definition Count" "MRDEF" "*" "KSRL" srl)
 297     (insert-ustats-count conn "Rank Count" "MRRANK" "*" "KSRL" srl)
 298     (insert-ustats-count conn "Relationship Count" "MRREL" "*" "KSRL" srl)
 299     (insert-ustats-count conn "Semantic Type Count" "MRSTY" "*" "KLRL" srl)
 300     (insert-ustats-count conn "Simple Attribute Count" "MRSAT" "*" "KSRL" srl)
 301     (insert-ustats-count conn "Source Abbreviation Count" "MRSAB" "*" "SRL" srl)
 302     (insert-ustats-count conn "Word Index Count" "MRXW_ENG" "*" "KLRL" srl)
 303     (insert-ustats-count conn "Normalized Word Index Count" "MRXNW_ENG" "*" "KLRL" srl)
 304     (insert-ustats-count conn "Normalized String Index Count" "MRXNS_ENG" "*" "KLRL" srl))
 305   (sql-execute "create index USTATS_SRL on USTATS (SRL)" conn)
 306   (find-ustats-all))
 307
 308 (defun insert-ustats-count (conn name table count-variable srl-control srl)
 309   (insert-ustats conn name (find-count-table conn table srl count-variable srl-control) srl))
 310
 311 (defun sql-create-special-tables (conn)
 312   (make-usrl conn)
 313   (make-ustats conn))
 314
 315 (defun create-umls-db-by-insert (&key verbose)
 316   "SQL Databases: initializes entire database via SQL insert commands"
 317   (ensure-ucols+ufiles)
 318   (ensure-preparse)
 319   (with-sql-connection (conn)
 320     (sql-drop-tables conn)
 321     (sql-create-tables conn)
 322     (sql-insert-all-values conn)
 323     (sql-create-indexes conn)
 324     (sql-create-custom-tables conn)
 325     (sql-create-indexes conn :indexes +custom-index-cols+ :verbose verbose)
 326     (sql-create-special-tables conn)))
 327
 328 (defun create-umls-db (&key (extension "-trans") (force-translation nil) (verbose nil))
 329   "SQL Databases: initializes entire database via SQL copy commands.
 330 This is much faster that using create-umls-db-insert."
 331   (when verbose (format t "UMLS Import: Starting.~%"))
 332   (ensure-ucols+ufiles)
 333   (when verbose (format t "UMLS Import: Preparsing files.~%"))
 334   (ensure-preparse)
 335   (when verbose (format t "UMLS Import: Converting text UMLS files to optimized format.~%"))
 336   (translate-all-files :extension extension :verbose verbose :force force-translation)
 337   (let ((copy-cmd
 338          (ecase (umls-sql-type)
 339            (:mysql #'mysql-copy-cmd)
 340            (:postgresql #'pg-copy-cmd))))
 341     (with-sql-connection (conn)
 342       (clsql:truncate-database :database conn)
 343       (sql-drop-tables conn)
 344       (sql-create-tables conn)
 345       (dolist (file *umls-files*)
 346         (when verbose (format t "UMLS Import: Importing file ~A to SQL.~%" (fil file)))
 347         (sql-execute (funcall copy-cmd file extension) conn))
 348       (when verbose (format t "UMLS Import: Creating SQL indices.~%"))
 349       (sql-create-indexes conn :verbose verbose)
 350       (when verbose (format t "UMLS Import: Creating custom tables.~%"))
 351       (sql-create-custom-tables conn)
 352       (when verbose (format t "UMLS Import: Creating custom indices.~%"))
 353       (sql-create-indexes conn :indexes +custom-index-cols+ :verbose verbose)
 354       (when verbose (format t "UMLS Import: Creating special tables.~%"))
 355       (sql-create-special-tables conn)))
 356   (when verbose (format t "UMLS Import: Completed.~%"))
 357   t)
 358
 359 (defun translate-all-files (&key (extension "-trans") verbose force)
 360   "Translate all *umls-files* to optimized import format."
 361   (when verbose (format t "UMLS Import: Translating file ~A.~%" (fil (find-ufile "MRXW_NONENG.RRF"))))
 362   (make-noneng-index-file extension :force force)
 363   (dolist (f (remove "MRXW_NONENG.RRF" *umls-files* :test #'string= :key #'fil))
 364     (when verbose (format t "UMLS Import: Translating file ~A.~%" (fil f)))
 365     (translate-umls-file f extension :force force)))
 366
 367 (defun translate-umls-file (file extension &key force)
 368   "Translate a umls file into a format suitable for sql copy cmd"
 369   (translate-files file extension (list file) :force force))
 370
 371 (defun make-noneng-index-file (extension &key force)
 372   "Make non-english index file"
 373   (translate-files (find-ufile "MRXW_NONENG.RRF")
 374                    extension (noneng-lang-index-files) :force force))
 375
 376 (defun verify-translation-file (output-path input-ufiles)
 377   "Returns t if translation file exists and is correct size. Warns and deletes incomplete translation file."
 378   (when (probe-file output-path)
 379     (let ((translated-lines 0)
 380           (input-lines 0)
 381           (eof (cons nil nil)))
 382       (with-open-file (ts output-path :direction :input
 383                           #+(and sbcl sb-unicode) :external-format
 384                           #+(and sbcl sb-unicode) :UTF-8
 385                           #+(and allegro ics) :external-format
 386                           #+(and allegro ics) :UTF-8
 387                           #+lispworks :external-format
 388                           #+lispworks :UTF-8
 389                           #+(and clisp unicode) :external-format
 390                           #+(and clisp unicode) charset:utf-8)
 391         (do ((c (read-char ts nil eof) (read-char ts nil eof)))
 392             ((eq c eof))
 393           (when (eql c #\newline)
 394             (incf translated-lines))))
 395       (dolist (input-ufile input-ufiles)
 396         (with-umls-ufile (line input-ufile)
 397           (incf input-lines)
 398           (when (> input-lines translated-lines)
 399             (return))))
 400       (cond
 401         ((< input-lines translated-lines)
 402           (format t "Translated file ~A incomplete, deleting...~%" output-path)
 403           (delete-file output-path)
 404           nil)
 405         ((eql input-lines translated-lines)
 406           (format t "Translated file ~A already exists: skipping...~%" output-path)
 407           t)
 408         ((eql input-lines 0)
 409           (warn "The number of input lines is 0 for output file ~A." output-path)
 410           nil)
 411         ((> translated-lines input-lines)
 412           (error "Shouldn't happen. Translated lines of ~A is ~D, greater than input lines ~D"
 413                  output-path translated-lines input-lines)
 414           (delete-file output-path)
 415           nil)))))
 416
 417 (defun translate-files (out-ufile extension input-ufiles &key force)
 418   "Translate a umls file into a format suitable for sql copy cmd"
 419   (let ((output-path (ufile-pathname out-ufile extension)))
 420     (when (and (not force) (verify-translation-file output-path input-ufiles))
 421       (return-from translate-files output-path))
 422     (with-open-file (ostream output-path :direction :output
 423                              :if-exists :overwrite
 424                              :if-does-not-exist :create
 425                              #+(and sbcl sb-unicode) :external-format
 426                              #+(and sbcl sb-unicode) :UTF-8
 427                              #+(and allegro ics) :external-format
 428                              #+(and allegro ics) :UTF-8
 429                              #+lispworks :external-format
 430                              #+lispworks :UTF-8
 431                              #+(and clisp unicode) :external-format
 432                              #+(and clisp unicode) charset:utf-8)
 433       (dolist (input-ufile input-ufiles)
 434         (with-umls-ufile (line input-ufile)
 435           (translate-line out-ufile line ostream)
 436           (princ #\newline ostream))))))
 437
 438 (defun translate-line (file line strm)
 439   "Translate a single line for sql output"
 440   (flet ((col-value (col value)
 441            (if (eq (datatype col) 'sql-u)
 442                (let ((ui (parse-ui value "")))
 443                  (if (stringp ui)
 444                      ui
 445                      (write-to-string ui)))
 446                (escape-backslashes value))))
 447     (print-separated-strings
 448      strm "|"
 449      (mapcar #'col-value (remove-custom-cols (ucols file)) line)
 450      (custom-col-values (custom-ucols-for-file file) line nil))))
 451
 452 (defun pg-copy-cmd (file extension)
 453   "Return postgresql copy statement for a file"
 454   (format
 455    nil "COPY ~a FROM '~a' using delimiters '|' with null as ''"
 456    (table file) (ufile-pathname file extension)))
 457
 458 (defun mysql-copy-cmd (file extension &key (local-file t))
 459   "Return mysql copy statement for a file"
 460   (format
 461    nil
 462    "LOAD DATA ~AINFILE '~a' INTO TABLE ~a FIELDS TERMINATED BY '|'"
 463    (if local-file "LOCAL " "")
 464    (namestring (ufile-pathname file extension)) (table file)))
 465
 466
 467 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 468 ;;;
 469 ;;; Routines for analyzing cost of fixed size storage
 470 ;;;
 471 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 472
 473 (defun umls-fixed-size-waste ()
 474   "Display storage waste if using all fixed size storage"
 475   (let ((totalwaste 0)
 476         (totalunavoidable 0)
 477         (totalavoidable 0)
 478         (unavoidable '())
 479         (avoidable '()))
 480     (dolist (file *umls-files*)
 481       (dolist (col (ucols file))
 482         (let* ((avwaste (- (cmax col) (av col)))
 483                (cwaste (* avwaste (rws file))))
 484           (when (plusp cwaste)
 485             (if (<= avwaste 6)
 486                 (progn
 487                   (incf totalunavoidable cwaste)
 488                   (push (list (fil file) (col col)
 489                               avwaste cwaste)
 490                         unavoidable))
 491                 (progn
 492                   (incf totalavoidable cwaste)
 493                   (push (list (fil file) (col col)
 494                               avwaste cwaste)
 495                         avoidable)))
 496             (incf totalwaste cwaste)))))
 497     (values totalwaste totalavoidable totalunavoidable
 498             (nreverse avoidable) (nreverse unavoidable))))
 499
 500 (defun display-waste ()
 501   (ensure-ucols+ufiles)
 502   (multiple-value-bind (tw ta tu al ul) (umls-fixed-size-waste)
 503     (format t "Total waste: ~d~%" tw)
 504     (format t "Total avoidable: ~d~%" ta)
 505     (format t "Total unavoidable: ~d~%" tu)
 506     (format t "Avoidable:~%")
 507     (dolist (w al)
 508       (format t "  (~a,~a): ~a,~a~%" (car w) (cadr w) (caddr w) (cadddr w)))
 509     (format t "Unavoidable:~%")
 510     (dolist (w ul)
 511       (format t "  (~a,~a): ~a,~a~%" (car w) (cadr w) (caddr w) (cadddr w)))
 512     ))
 513
 514 (defun max-umls-field ()
 515   "Return length of longest field"
 516   (declare (optimize (speed 3) (space 0)))
 517   (ensure-ucols+ufiles)
 518   (let ((max 0))
 519     (declare (type (integer 0 1000000) max))
 520     (dolist (ucol *umls-cols*)
 521       (when (> (the (integer 0 1000000) (cmax ucol)) max)
 522         (setq max (cmax ucol))))
 523     max))
 524
 525 (defun max-umls-row ()
 526   "Return length of longest row"
 527   (declare (optimize (speed 3) (space 0)))
 528   (ensure-ucols+ufiles)
 529   (let ((rowsizes '()))
 530     (dolist (file *umls-files*)
 531       (let ((row 0))
 532         (declare (type (integer 0 1000000) row))
 533         (dolist (ucol (ucols file))
 534           (let* ((col-max (cmax ucol))
 535                  (max-with-delim (1+ col-max)))
 536             (declare (type (integer 0 1000000) col-max max-with-delim))
 537             (incf row max-with-delim)))
 538         (push row rowsizes)))
 539     (car (sort rowsizes #'>))))