-
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;; 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.
(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
(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
(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)
(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)
(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)
(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*))
(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"
(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
(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)))))
(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"
(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 #'>))))))
projects / umlisp.git / commitdiff