From 12eb212f7d42e18fc310ff08d526d8beea74fb91 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Thu, 7 Nov 2002 23:19:02 +0000 Subject: [PATCH] r3335: *** empty log message *** --- sql-create.lisp | 183 ++++++++++++++++++++++++------------------------ 1 file changed, 91 insertions(+), 92 deletions(-) diff --git a/sql-create.lisp b/sql-create.lisp index 2c35d9a..5b7794b 100644 --- a/sql-create.lisp +++ b/sql-create.lisp @@ -1,4 +1,3 @@ - ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION @@ -8,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: sql-create.lisp,v 1.3 2002/10/21 08:23:52 kevin Exp $ +;;;; $Id: sql-create.lisp,v 1.4 2002/11/07 23:19:02 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -22,27 +21,27 @@ (defun create-table-cmd (file) -"Return sql command to create a table" + "Return sql command to create a table" (let ((col-func (lambda (c) (let ((sqltype (umls-col-sqltype c))) (concatenate 'string (umls-col-col c) - " " - (if (or (string-equal sqltype "VARCHAR") - (string-equal sqltype "CHAR")) - (format nil "~a (~a)" sqltype (umls-col-max c)) - sqltype) - ","))))) + " " + (if (or (string-equal sqltype "VARCHAR") + (string-equal sqltype "CHAR")) + (format nil "~a (~a)" sqltype (umls-col-max c)) + sqltype) + ","))))) (format nil "CREATE TABLE ~a (~a)" (umls-file-table file) (string-trim-last-character (mapcar-append-string col-func (umls-cols-for-umls-file file)))))) (defun create-custom-table-cmd (tablename sql-cmd) -"Return SQL command to create a custom table" + "Return SQL command to create a custom table" (format nil "CREATE TABLE ~a AS ~a;" tablename sql-cmd)) (defun insert-values-cmd (file values) -"Return sql insert command for a row of values" + "Return sql insert command for a row of values" (let ((insert-func (lambda (col value) (concatenate @@ -50,7 +49,7 @@ (umls-col-quotechar col) (if (null (umls-col-parsefunc col)) value - (format nil "~A" (funcall (umls-col-parsefunc col) value))) + (format nil "~A" (funcall (umls-col-parsefunc col) value))) (umls-col-quotechar col) ",")))) (format @@ -61,10 +60,10 @@ (umls-file-fields file))) (string-trim-last-character (concatenate 'string - (mapcar2-append-string insert-func - (remove-custom-cols (umls-file-colstructs file)) - values) - (custom-col-values (custom-colstructs-for-file file) values "," t))) + (mapcar2-append-string insert-func + (remove-custom-cols (umls-file-colstructs file)) + values) + (custom-col-values (custom-colstructs-for-file file) values "," t))) ))) (defun custom-col-values (colstructs values delim doquote) @@ -100,61 +99,61 @@ (defun noneng-lang-index-files () (remove-if-not (lambda (f) (and (> (length (umls-file-fil f)) 4) - (string-equal (umls-file-fil f) "MRXW." :end1 5) - (not (string-equal (umls-file-fil f) "MRXW.ENG")) - (not (string-equal (umls-file-fil f) "MRXW.NONENG")))) + (string-equal (umls-file-fil f) "MRXW." :end1 5) + (not (string-equal (umls-file-fil f) "MRXW.ENG")) + (not (string-equal (umls-file-fil f) "MRXW.NONENG")))) *umls-files*)) ;;; SQL Command Functions (defun create-index-cmd (colname tablename length) -"Return sql create index command" + "Return sql create index command" (format nil "CREATE INDEX ~a ON ~a (~a ~a)" - (concatenate 'string tablename "_" colname "_X") tablename colname - (if (integerp length) - (format nil "(~d)" length) - ""))) + (concatenate 'string tablename "_" colname "_X") tablename colname + (if (integerp length) + (format nil "(~d)" length) + ""))) (defun create-all-tables-cmdfile () -"Return sql commands to create all tables. Not need for automated SQL import" + "Return sql commands to create all tables. Not need for automated SQL import" (mapcar (lambda (f) (format nil "~a~%~%" (create-table-cmd f))) *umls-files*)) ;; SQL Execution functions (defun sql-drop-tables (conn) -"SQL Databases: drop all tables" + "SQL Databases: drop all tables" (mapcar (lambda (file) (ignore-errors - (sql-execute (format nil "DROP TABLE ~a" (umls-file-table file)) conn))) + (sql-execute (format nil "DROP TABLE ~a" (umls-file-table file)) conn))) *umls-files*)) (defun sql-create-tables (conn) -"SQL Databases: create all tables" + "SQL Databases: create all tables" (mapcar (lambda (file) (sql-execute (create-table-cmd file) conn)) *umls-files*)) (defun sql-create-custom-tables (conn) -"SQL Databases: create all custom tables" + "SQL Databases: create all custom tables" (mapcar (lambda (ct) - (sql-execute (create-custom-table-cmd (car ct) (cadr ct)) conn)) - +custom-tables+)) + (sql-execute (create-custom-table-cmd (car ct) (cadr ct)) conn)) + +custom-tables+)) (defun sql-insert-values (conn file) -"SQL Databases: inserts all values for a file" + "SQL Databases: inserts all values for a file" (with-umls-file (line (umls-file-fil file)) - (sql-execute (insert-values-cmd file line) conn))) + (sql-execute (insert-values-cmd file line) conn))) (defun sql-insert-all-values (conn) -"SQL Databases: inserts all values for all files" + "SQL Databases: inserts all values for all files" (mapcar (lambda (file) (sql-insert-values conn file)) *umls-files*)) (defun sql-create-indexes (conn &optional (indexes +index-cols+)) -"SQL Databases: create all indexes" -(mapcar - (lambda (idx) - (sql-execute (create-index-cmd (car idx) (cadr idx) (caddr idx)) conn)) - indexes)) + "SQL Databases: create all indexes" + (mapcar + (lambda (idx) + (sql-execute (create-index-cmd (car idx) (cadr idx) (caddr idx)) conn)) + indexes)) (defun make-usrl (conn) (sql-execute "drop table if exists USRL" conn) @@ -168,20 +167,20 @@ (make-usrl conn)) (defun create-umls-db-by-insert () -"SQL Databases: initializes entire database via SQL insert commands" + "SQL Databases: initializes entire database via SQL insert commands" (init-umls) (init-hash-table) (with-sql-connection (conn) - (sql-drop-tables conn) - (sql-create-tables conn) - (sql-insert-all-values conn) - (sql-create-indexes conn) - (sql-create-custom-tables conn) - (sql-create-indexes conn +custom-index-cols+) - (sql-create-special-tables conn))) + (sql-drop-tables conn) + (sql-create-tables conn) + (sql-insert-all-values conn) + (sql-create-indexes conn) + (sql-create-custom-tables conn) + (sql-create-indexes conn +custom-index-cols+) + (sql-create-special-tables conn))) (defun create-umls-db (&optional (extension ".trans") - (copy-cmd #'mysql-copy-cmd)) + (copy-cmd #'mysql-copy-cmd)) "SQL Databases: initializes entire database via SQL copy commands. This is much faster that using create-umls-db-insert." (init-umls) @@ -199,7 +198,7 @@ This is much faster that using create-umls-db-insert." (sql-create-special-tables conn))) (defun translate-all-files (&optional (extension ".trans")) -"Copy translated files and return postgresql copy commands to import" + "Copy translated files and return postgresql copy commands to import" (make-noneng-index-file extension) (mapcar (lambda (f) (translate-file f extension)) *umls-files*)) @@ -210,11 +209,11 @@ This is much faster that using create-umls-db-insert." (progn (format t "File ~A already exists: skipping~%" path) nil) - (with-open-file (ostream path :direction :output) - (with-umls-file (line (umls-file-fil file)) - (princ (umls-translate file line) ostream) - (princ #\newline ostream)) - t)))) + (with-open-file (ostream path :direction :output) + (with-umls-file (line (umls-file-fil file)) + (princ (umls-translate file line) ostream) + (princ #\newline ostream)) + t)))) (defun make-noneng-index-file (extension) "Make non-english index file" @@ -225,39 +224,39 @@ This is much faster that using create-umls-db-insert." (progn (format t "File ~A already exists: skipping~%" path) nil) - (progn - (with-open-file (ostream path :direction :output) - (dolist (inputfile (noneng-lang-index-files)) - (with-umls-file (line (umls-file-fil inputfile)) - (princ (umls-translate outfile line) ostream) ;; use outfile for custom cols - (princ #\newline ostream)))) - t)))) + (progn + (with-open-file (ostream path :direction :output) + (dolist (inputfile (noneng-lang-index-files)) + (with-umls-file (line (umls-file-fil inputfile)) + (princ (umls-translate outfile line) ostream) ;; use outfile for custom cols + (princ #\newline ostream)))) + t)))) (defun pg-copy-cmd (file extension) -"Return postgresql copy statement for a file" + "Return postgresql copy statement for a file" (format nil "COPY ~a FROM '~a' using delimiters '|' with null as ''" (umls-file-table file) (umls-pathname (umls-file-fil file) extension))) (defun mysql-copy-cmd (file extension) -"Return mysql copy statement for a file" + "Return mysql copy statement for a file" (format nil "LOAD DATA LOCAL INFILE \"~a\" INTO TABLE ~a FIELDS TERMINATED BY \"|\"" - (umls-pathname (umls-file-fil file) extension) (umls-file-table file))) + (umls-pathname (umls-file-fil file) extension) (umls-file-table file))) (defun umls-translate (file line) -"Translate a single line for sql output" -(string-trim-last-character - (concatenate 'string - (mapcar2-append-string - (lambda (col value) - (concatenate - 'string - (if (eq (umls-col-datatype col) 'sql-u) - (format nil "~d" (parse-ui value "")) - (escape-backslashes value)) - "|")) - (remove-custom-cols (umls-file-colstructs file)) - line) - (custom-col-values (custom-colstructs-for-file file) line "|" nil)))) + "Translate a single line for sql output" + (string-trim-last-character + (concatenate 'string + (mapcar2-append-string + (lambda (col value) + (concatenate + 'string + (if (eq (umls-col-datatype col) 'sql-u) + (format nil "~d" (parse-ui value "")) + (escape-backslashes value)) + "|")) + (remove-custom-cols (umls-file-colstructs file)) + line) + (custom-col-values (custom-colstructs-for-file file) line "|" nil)))) ;;; Routines for analyzing cost of fixed size storage @@ -279,7 +278,7 @@ This is much faster that using create-umls-db-insert." (progn (incf totalunavoidable cwaste) (setq unavoidable (append unavoidable (list (list (umls-file-fil file) (umls-col-col col) avwaste cwaste))))) - (progn + (progn (incf totalavoidable cwaste) (setq avoidable (append avoidable (list (list (umls-file-fil file) (umls-col-col col) avwaste cwaste)))))) (incf totalwaste cwaste))))) @@ -298,7 +297,7 @@ This is much faster that using create-umls-db-insert." (format t "Unavoidable:~%") (dolist (w ul) (format t " (~a,~a): ~a,~a~%" (car w) (cadr w) (caddr w) (cadddr w))) - )) + )) (defun max-umls-field () "Return length of longest field" @@ -314,15 +313,15 @@ This is much faster that using create-umls-db-insert." (defun max-umls-row () "Return length of longest row" (if t - 6000 ;;; hack to use on systems without MRCOLS/MRFILES -- ok for UMLS2001 - (progn - (unless *umls-files* - (init-umls)) - (let ((rowsizes '())) - (dolist (file *umls-files*) - (let ((row 0) - (fields (umls-file-colstructs file))) - (dolist (field fields) - (incf row (1+ (umls-col-max field)))) - (push row rowsizes))) - (car (sort rowsizes #'>)))))) + 6000 ;;; hack to use on systems without MRCOLS/MRFILES -- ok for UMLS2001 + (progn + (unless *umls-files* + (init-umls)) + (let ((rowsizes '())) + (dolist (file *umls-files*) + (let ((row 0) + (fields (umls-file-colstructs file))) + (dolist (field fields) + (incf row (1+ (umls-col-max field)))) + (push row rowsizes))) + (car (sort rowsizes #'>)))))) -- 2.34.1