From f2f3771917e7d8c2999615d3f30641c8ee251872 Mon Sep 17 00:00:00 2001
From: Kevin Rosenberg <kevin@rosenberg.net>
Date: Mon, 15 Feb 2010 17:15:06 -0700
Subject: [PATCH] Optimize index creation when multiple indices on same table

---
 create-sql.lisp      |  60 +++++++-
 data-structures.lisp |   2 +-
 package.lisp         | 345 +++++++++++++++++++++----------------------
 sql-classes.lisp     |   2 +-
 sql.lisp             |  10 +-
 5 files changed, 231 insertions(+), 188 deletions(-)

diff --git a/create-sql.lisp b/create-sql.lisp
index 79732eb..88fa898 100644
--- a/create-sql.lisp
+++ b/create-sql.lisp
@@ -206,13 +206,56 @@
      (format nil "DROP INDEX ~a"
              (concatenate 'string tablename "_" colname "_X")))))
 
+(defun sql-create-indexes-mysql (conn indexes verbose)
+  (let ((tables nil)
+        (table-cols nil))
+    (dolist (idx indexes)
+      (pushnew (second idx) tables :test 'string-equal)
+      (let ((table-col (find (second idx) table-cols :key 'car :test 'string-equal)))
+        (if table-col
+            (vector-push-extend (cons (first idx) (third idx)) (second table-col))
+            (push (list (second idx) (make-array (list 1) :initial-contents (list (cons (first idx) (third idx)))
+                                                 :adjustable t :fill-pointer 1))
+                  table-cols))))
+    (dolist (table tables)
+      (let ((table-col (find table table-cols :key 'car :test 'string-equal))
+            (first t)
+            (str (format nil "ALTER TABLE ~A" table)))
+        (loop for col across (second table-col)
+           do
+             (let ((colname (car col))
+                   (length (cdr col)))
+               (ignore-errors (sql-execute (drop-index-cmd colname table) conn))
+               (setq str (concatenate 'string
+                                      str
+                                      (if first
+                                          (progn
+                                            (setq first nil)
+                                            " ")
+                                          ", ")
+                                      (format nil "ADD INDEX ~A (~A)"
+                                              (concatenate 'string table "_" colname "_X")
+                                              (concatenate 'string
+                                                           colname
+                                                           (if (integerp length)
+                                                               (format nil " (~d)" length)
+                                                               "")))))))
+        (when verbose
+          (format t "UMLS Import: Creating indexes for columns ~A on table ~A.~%"
+                  (mapcar 'car (coerce (second table-col) 'list)) table))
+        (when conn
+          (sql-execute str conn))
+        ))))
+
 (defun sql-create-indexes (conn &key (indexes +index-cols+) verbose)
   "SQL Databases: create all indexes"
-  (dolist (idx indexes)
-    (when verbose (format t "UMLS Import: Creating index for column ~A on table ~A.~%"
-                          (first idx) (second idx)))
-    (ignore-errors (sql-execute (drop-index-cmd (car idx) (cadr idx)) conn))
-    (sql-execute (create-index-cmd (car idx) (cadr idx) (caddr idx)) conn)))
+  (if (eql :mysql *umls-sql-type*)
+      (sql-create-indexes-mysql conn indexes verbose)
+      (dolist (idx indexes)
+        (when verbose (format t "UMLS Import: Creating index for column ~A on table ~A.~%"
+                              (first idx) (second idx)))
+        (ignore-errors (sql-execute (drop-index-cmd (car idx) (cadr idx)) conn))
+        (sql-execute (create-index-cmd (car idx) (cadr idx) (caddr idx)) conn))))
 
 (defun make-usrl (conn)
   (if (eql :mysql *umls-sql-type*)
@@ -306,9 +349,10 @@ This is much faster that using create-umls-db-insert."
                             #+lispworks :UTF-8
                             #+(and clisp unicode) :external-format
                             #+(and clisp unicode) charset:utf-8)
-          (do ()
-              ((eq (read-line ts nil eof) eof))
-            (incf translated-lines)))
+          (do ((c (read-char ts nil eof) (read-char ts nil eof)))
+              ((eq c eof))
+            (when (eql c #\newline)
+              (incf translated-lines))))
         (dolist (input-ufile input-ufiles)
           (with-umls-ufile (line input-ufile)
                            (incf input-lines)
diff --git a/data-structures.lisp b/data-structures.lisp
index c869160..4672d4b 100644
--- a/data-structures.lisp
+++ b/data-structures.lisp
@@ -42,7 +42,7 @@
 (defparameter *net-path*
   (merge-pathnames *net-dir* *umls-path*))
 
-(defun umls-path! (p)
+(defun (setf umls-path) (p)
   (setq *umls-path* (etypecase p
                       (string (parse-namestring p))
                       (pathname p)))
diff --git a/package.lisp b/package.lisp
index 26a41a1..3bb601b 100644
--- a/package.lisp
+++ b/package.lisp
@@ -18,185 +18,184 @@
 
 (eval-when (:compile-toplevel :load-toplevel :execute) ;; enclose reader macro
   (defpackage #:umlisp
-  (:nicknames #:u)
-  (:use #:kmrcl #:common-lisp #:hyperobject)
-  (:export
-   #:dummy
-   .
-   ;; From classes.lisp
-   #1=(#:umlsclass
-       #:ucon #:uterm #:ustr #:usrl #:uso #:urank #:udef #:usat #:usab
-       #:urel #:ucoc #:usty #:uxw #:uxnw  #:uxns
-       #:lexterm #:labr #:lagr #:lcmp #:lmod #:lnom #:lprn #:lprp #:lspl #:ltrm
-       #:ltyp #:lwd #:sdef #:sstr #:sstre1 #:sstre2
-       #:sty #:tui #:def #:sab #:srl #:tty #:rank #:suppress #:atn #:atv #:vcui
-       #:rcui #:vsab #:code #:saui #:scui #:sdui #:ispref
-       #:rl #:sty2 #:ui #:ui2 #:ui3 #:eui #:bas #:eui2 #:bas2 #:rui
-       #:cui #:aui #:lui #:sui #:wd #:lat #:nstr :cuilist
-       #:rsab #:lat
-       #:s#def #:s#sty #:s#term #:s#str #:s#lo #:s#sat #:s#rel #:s#coc
-       #:s#so
-       #:pfstr #:pfstr2 #:lrl #:def #:ts #:cui1 #:cui2 #:rela #:sl #:mg #:rel
-       #:soc #:cot #:cof #:coa #:isn #:fr #:un #:sna #:soui #:hcd #:stt #:str
-       #:kpfeng :cvf
+    (:nicknames #:u)
+    (:use #:kmrcl #:common-lisp #:hyperobject)
+    (:export
+     #:dummy
+     .
+     ;; From classes.lisp
+     #1=(#:umlsclass
+         #:ucon #:uterm #:ustr #:usrl #:uso #:urank #:udef #:usat #:usab
+         #:urel #:ucoc #:usty #:uxw #:uxnw  #:uxns
+         #:lexterm #:labr #:lagr #:lcmp #:lmod #:lnom #:lprn #:lprp #:lspl #:ltrm
+         #:ltyp #:lwd #:sdef #:sstr #:sstre1 #:sstre2
+         #:sty #:tui #:def #:sab #:srl #:tty #:rank #:suppress #:atn #:atv #:vcui
+         #:rcui #:vsab #:code #:saui #:scui #:sdui #:ispref
+         #:rl #:sty2 #:ui #:ui2 #:ui3 #:eui #:bas #:eui2 #:bas2 #:rui
+         #:cui #:aui #:lui #:sui #:wd #:lat #:nstr :cuilist
+         #:rsab #:lat
+         #:s#def #:s#sty #:s#term #:s#str #:s#lo #:s#sat #:s#rel #:s#coc
+         #:s#so
+         #:pfstr #:pfstr2 #:lrl #:def #:ts #:cui1 #:cui2 #:rela #:sl #:mg #:rel
+         #:soc #:cot #:cof #:coa #:isn #:fr #:un #:sna #:soui #:hcd #:stt #:str
+         #:kpfeng :cvf
 
-   ;; From class-support.lisp
-   #:ucon-has-tui
-   #:english-term-p #:remove-non-english-terms #:remove-english-terms
-   #:fmt-cui #:fmt-tui #:fmt-sui #:fmt-eui #:fmt-tui #:fmt-aui
-   #:display-con #:display-term #:display-str
-   #:pfstr #:pf-ustr
-   #:cui-p #:lui-p #:sui-p #:tui-p #:eui-p
-   #:rel-abbr-info #:filter-urels-by-rel
-   #:mesh-number #:ucon-ustrs
-   #:lat-abbr-info #:stt-abbr-info
-   #:uso-unique-codes #:ucon-has-sab
+         ;; From class-support.lisp
+         #:ucon-has-tui
+         #:english-term-p #:remove-non-english-terms #:remove-english-terms
+         #:fmt-eui #:fmt-aui
+         #:display-con #:display-term #:display-str
+         #:pfstr #:pf-ustr
+         #:cui-p #:lui-p #:sui-p #:tui-p #:eui-p
+         #:rel-abbr-info #:filter-urels-by-rel
+         #:mesh-number #:ucon-ustrs
+         #:lat-abbr-info #:stt-abbr-info
+         #:uso-unique-codes #:ucon-has-sab
 
-   ;; From sql.lisp
-   #:*umls-sql-db*
-   #:umls-sql-user!
-   #:umls-sql-passwd!
-   #:umls-sql-db!
-   #:umls-sql-host!
-   #:umls-sql-type!
+         ;; From sql.lisp
+         #:*umls-sql-db*
+         #:umls-sql-user
+         #:umls-sql-passwd
+         #:umls-sql-db
+         #:umls-sql-host
+         #:umls-sql-type
 
-   ;; From utils.lisp
-   #:fmt-cui
-   #:fmt-lui
-   #:fmt-sui
-   #:fmt-tui
-   #:find-uterm-in-ucon
-   #:find-ustr-in-uterm
-   #:find-ustr-in-ucon
-   #:*current-srl*
-   #:parse-cui #:parse-lui #:parse-sui #:parse-tui #:parse-eui
+         ;; From utils.lisp
+         #:fmt-cui
+         #:fmt-lui
+         #:fmt-sui
+         #:fmt-tui
+         #:find-uterm-in-ucon
+         #:find-ustr-in-uterm
+         #:find-ustr-in-ucon
+         #:*current-srl*
+         #:parse-cui #:parse-lui #:parse-sui #:parse-tui #:parse-eui
 
-   ;; From sql-classes.lisp
+         ;; From sql-classes.lisp
+         #:find-udef-cui
+         #:find-usty-cui
+         #:find-usty-word
+         #:find-urel-cui
+         #:find-cui2-urel-cui
+         #:find-urel-cui2
+         #:find-ucon-rel-cui2
+         #:find-ucoc-cui
+         #:find-ucoc-cui2
+         #:find-ucon-coc-cui2
+         #:find-usty-sty
+         #:suistr
+         #:print-umlsclass
+         #:find-ucon-cui #:make-ucon-cui
+         #:find-uconso-cui
+         #:find-uconso-sui
+         #:find-uconso-code
+         #:find-ucon-lui
+         #:find-ucon-sui
+         #:find-ucon-cuisui
+         #:find-ucon-str
+         #:find-ucon-all
+         #:find-cui-ucon-all
+         #:map-ucon-all
+         #:find-uterm-cui
+         #:find-uterm-lui
+         #:find-uterm-cuilui
+         #:find-uterm-in-ucon
+         #:find-ustr-cuilui
+         #:find-ustr-cuisui
+         #:find-ustr-sui
+         #:find-ustr-sab
+         #:find-ustr-all
+         #:find-string-sui
+         #:find-uso-cuisui
+         #:find-uso-cui
+         #:find-uso-aui
+         #:find-usat-ui
+         #:find-usab-all
+         #:find-usab-rsab
+         #:find-usab-vsab
+         #:find-pfstr-cui
+         #:find-ustr-in-uterm
+         #:find-usty-tui
+         #:find-usty-all
+         #:find-usty_freq-all
+         #:find-usrl-all
+         #:find-usrl_freq-all
+         #:find-cui-max
+         #:find-ucon-tui
+         #:find-ucon-word
+         #:find-ucon-normalized-word
+         #:find-cui-normalized-word
+         #:find-lui-normalized-word
+         #:find-sui-normalized-word
+         #:find-ustr-word
+         #:find-ustr-normalized-word
+         #:find-uterm-multiword
+         #:find-uterm-word
+         #:find-uterm-normalized-word
+         #:find-ucon-multiword
+         #:find-uconso-multiword
+         #:find-ucon-normalized-multiword
+         #:find-ustr-multiword
+         #:find-ustr-normalized-multiword
+         #:find-lexterm-eui
+         #:find-lexterm-word
+         #:find-labr-eui
+         #:find-labr-bas
+         #:find-lagr-eui
+         #:find-lcmp-eui
+         #:find-lmod-eui
+         #:find-lnom-eui
+         #:find-lprn-eui
+         #:find-lprp-eui
+         #:find-lspl-eui
+         #:find-ltrm-eui
+         #:find-ltyp-eui
+         #:find-lwd-wrd
+         #:find-sdef-ui
+         #:find-sstre1-ui
+         #:find-sstre1-ui2
+         #:find-sstr2-sty
+         #:find-sstr-rl
+         #:find-sstr-styrl
+         #:display-con
+         #:display-term
+         #:display-str
+         #:find-ustats-all
+         #:find-ustats-srl
+         #:find-bsab-sab
+         #:find-bsab-all
+         #:find-btty-all
+         #:find-btty-tty
+         #:find-brel-rel
 
-   #:find-udef-cui
-   #:find-usty-cui
-   #:find-usty-word
-   #:find-urel-cui
-   #:find-cui2-urel-cui
-   #:find-urel-cui2
-   #:find-ucon-rel-cui2
-   #:find-ucoc-cui
-   #:find-ucoc-cui2
-   #:find-ucon-coc-cui2
-   #:find-usty-sty
-   #:suistr
-   #:print-umlsclass
-   #:find-ucon-cui #:make-ucon-cui
-   #:find-uconso-cui
-   #:find-uconso-sui
-   #:find-uconso-code
-   #:find-ucon-lui
-   #:find-ucon-sui
-   #:find-ucon-cuisui
-   #:find-ucon-str
-   #:find-ucon-all
-   #:find-cui-ucon-all
-   #:map-ucon-all
-   #:find-uterm-cui
-   #:find-uterm-lui
-   #:find-uterm-cuilui
-   #:find-uterm-in-ucon
-   #:find-ustr-cuilui
-   #:find-ustr-cuisui
-   #:find-ustr-sui
-   #:find-ustr-sab
-   #:find-ustr-all
-   #:find-string-sui
-   #:find-uso-cuisui
-   #:find-uso-cui
-   #:find-uso-aui
-   #:find-usat-ui
-   #:find-usab-all
-   #:find-usab-rsab
-   #:find-usab-vsab
-   #:find-pfstr-cui
-   #:find-ustr-in-uterm
-   #:find-usty-tui
-   #:find-usty-all
-   #:find-usty_freq-all
-   #:find-usrl-all
-   #:find-usrl_freq-all
-   #:find-cui-max
-   #:find-ucon-tui
-   #:find-ucon-word
-   #:find-ucon-normalized-word
-   #:find-cui-normalized-word
-   #:find-lui-normalized-word
-   #:find-sui-normalized-word
-   #:find-ustr-word
-   #:find-ustr-normalized-word
-   #:find-uterm-multiword
-   #:find-uterm-word
-   #:find-uterm-normalized-word
-   #:find-ucon-multiword
-   #:find-uconso-multiword
-   #:find-ucon-normalized-multiword
-   #:find-ustr-multiword
-   #:find-ustr-normalized-multiword
-   #:find-lexterm-eui
-   #:find-lexterm-word
-   #:find-labr-eui
-   #:find-labr-bas
-   #:find-lagr-eui
-   #:find-lcmp-eui
-   #:find-lmod-eui
-   #:find-lnom-eui
-   #:find-lprn-eui
-   #:find-lprp-eui
-   #:find-lspl-eui
-   #:find-ltrm-eui
-   #:find-ltyp-eui
-   #:find-lwd-wrd
-   #:find-sdef-ui
-   #:find-sstre1-ui
-   #:find-sstre1-ui2
-   #:find-sstr2-sty
-   #:find-sstr-rl
-   #:find-sstr-styrl
-   #:display-con
-   #:display-term
-   #:display-str
-   #:find-ustats-all
-   #:find-ustats-srl
-   #:find-bsab-sab
-   #:find-bsab-all
-   #:find-btty-all
-   #:find-btty-tty
-   #:find-brel-rel
+         ;; composite.lisp
+         #:tui-finding
+         #:tui-sign-or-symptom
+         #:tui-disease-or-syndrome
+         #:ucon-is-tui?
+         #:find-ucon2-tui
+         #:find-ucon2-coc-tui
+         #:find-ucon2-rel-tui
+         #:find-ucon2_freq-coc-tui
+         #:find-ucon2-str&sty
+         #:find-ucon2-coc-str&sty
+         #:find-ucon2-rel-str&sty
+         #:find-ucon2_freq-tui-all
+         #:find-ucon2_freq-rel-tui-all
+         #:find-ucon2_freq-coc-tui-all
+         #:ucon_freq
+         #:ustr_freq
+         #:usty_freq
+         #:usrl_freq
 
-   ;; composite.lisp
-   #:tui-finding
-   #:tui-sign-or-symptom
-   #:tui-disease-or-syndrome
-   #:ucon-is-tui?
-   #:find-ucon2-tui
-   #:find-ucon2-coc-tui
-   #:find-ucon2-rel-tui
-   #:find-ucon2_freq-coc-tui
-   #:find-ucon2-str&sty
-   #:find-ucon2-coc-str&sty
-   #:find-ucon2-rel-str&sty
-   #:find-ucon2_freq-tui-all
-   #:find-ucon2_freq-rel-tui-all
-   #:find-ucon2_freq-coc-tui-all
-   #:ucon_freq
-   #:ustr_freq
-   #:usty_freq
-   #:usrl_freq
+         ;; from data-structures.lisp
+         #:umls-path
+         )))
 
-   ;; from data-structures.lisp
-   #:umls-path!
-   )))
-
-(defpackage umlisp-user
-  (:use  #:kmrcl #:common-lisp #:hyperobject)
-  (:import-from :umlisp . #1#)
-  (:export . #1#)
-  (:documentation "User package for UMLisp")))
+  (defpackage umlisp-user
+    (:use  #:kmrcl #:common-lisp #:hyperobject)
+    (:import-from :umlisp . #1#)
+    (:export . #1#)
+    (:documentation "User package for UMLisp")))
 
 
diff --git a/sql-classes.lisp b/sql-classes.lisp
index 8fe7d95..2805b80 100644
--- a/sql-classes.lisp
+++ b/sql-classes.lisp
@@ -20,7 +20,7 @@
 (defvar *current-srl* nil)
 (defun current-srl ()
   *current-srl*)
-(defun current-srl! (srl)
+(defun (setf current-srl) (srl)
   (setq *current-srl* srl))
 
 (defmacro query-string (table fields srl where-name where-value
diff --git a/sql.lisp b/sql.lisp
index 207d68c..565672e 100644
--- a/sql.lisp
+++ b/sql.lisp
@@ -30,7 +30,7 @@
 (defun umls-sql-db ()
   *umls-sql-db*)
 
-(defun umls-sql-db! (db)
+(defun (setf umls-sql-db) (db)
   (etypecase db
     (string
      (setq *umls-sql-db* db))
@@ -40,28 +40,28 @@
 (defvar *umls-sql-user* "secret")
 (defun umls-sql-user ()
   *umls-sql-user*)
-(defun umls-sql-user! (u)
+(defun (setf umls-sql-user) (u)
   (sql-disconnect-pooled)
   (setq *umls-sql-user* u))
 
 (defvar *umls-sql-passwd* "secret")
 (defun umls-sql-passwd ()
   *umls-sql-passwd*)
-(defun umls-sql-passwd! (p)
+(defun (setf umls-sql-passwd) (p)
   (sql-disconnect-pooled)
   (setq *umls-sql-passwd* p))
 
 (defvar *umls-sql-host* "localhost")
 (defun umls-sql-host ()
   *umls-sql-host*)
-(defun umls-sql-host! (h)
+(defun (setf umls-sql-host) (h)
   (sql-disconnect-pooled)
   (setq *umls-sql-host* h))
 
 (defvar *umls-sql-type* :mysql)
 (defun umls-sql-type ()
   *umls-sql-type*)
-(defun umls-sql-type! (h)
+(defun (setf umls-sql-type) (h)
   (sql-disconnect-pooled)
   (setq *umls-sql-type* h))
 
-- 
2.34.1