From cc146d0b1c7d6d7a050713754f1ea9a8d71a46b5 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Tue, 6 May 2003 02:14:59 +0000 Subject: [PATCH] r4826: *** empty log message *** --- composite.lisp | 10 ++++++---- data-structures.lisp | 9 +++++---- package.lisp | 7 +++++-- sql-create.lisp | 15 ++++++++++----- sql.lisp | 13 ++++++------- tests.lisp | 14 +++++++++++--- utils.lisp | 35 +++++++++++++++-------------------- 7 files changed, 58 insertions(+), 45 deletions(-) diff --git a/composite.lisp b/composite.lisp index 07fe8ae..c28cc95 100644 --- a/composite.lisp +++ b/composite.lisp @@ -4,10 +4,10 @@ ;;;; ;;;; Name: composite.lisp ;;;; Purpose: Composite Classes for UMLisp -;;;; Programmer: Kevin M. Rosenberg +;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: composite.lisp,v 1.20 2003/01/17 18:40:49 kevin Exp $ +;;;; $Id: composite.lisp,v 1.21 2003/05/06 02:14:59 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -16,8 +16,10 @@ ;;;; as governed by the terms of the GNU General Public License. ;;;; ************************************************************************* -(in-package :umlisp) -(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))) +(in-package #:umlisp) + +(eval-when (:compile-toplevel) + (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))) ;;; Semantic type constants diff --git a/data-structures.lisp b/data-structures.lisp index a6b1f02..9f41d77 100644 --- a/data-structures.lisp +++ b/data-structures.lisp @@ -4,10 +4,10 @@ ;;;; ;;;; Name: data-structures.lisp ;;;; Purpose: Basic data objects for UMLisp -;;;; Programmer: Kevin M. Rosenberg +;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: data-structures.lisp,v 1.5 2002/12/23 21:59:44 kevin Exp $ +;;;; $Id: data-structures.lisp,v 1.6 2003/05/06 02:14:59 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -16,9 +16,10 @@ ;;;; as governed by the terms of the GNU General Public License. ;;;; ************************************************************************* -(in-package :umlisp) -(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))) +(in-package #:umlisp) +(eval-when (:compile-toplevel) + (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))) ;;; Paths for files diff --git a/package.lisp b/package.lisp index 012e58a..081df86 100644 --- a/package.lisp +++ b/package.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: package.lisp,v 1.17 2003/05/06 01:34:57 kevin Exp $ +;;;; $Id: package.lisp,v 1.18 2003/05/06 02:14:59 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -59,7 +59,10 @@ #:fmt-lui #:fmt-sui #:fmt-tui - + #:find-uterm-in-ucon + #:find-ustr-in-uterm + #:find-ustr-in-ucon + #:*current-srl* ;; From sql-classes.lisp diff --git a/sql-create.lisp b/sql-create.lisp index 19be192..c9821fd 100644 --- a/sql-create.lisp +++ b/sql-create.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: sql-create.lisp,v 1.8 2003/05/06 01:34:57 kevin Exp $ +;;;; $Id: sql-create.lisp,v 1.9 2003/05/06 02:14:59 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -254,16 +254,21 @@ This is much faster that using create-umls-db-insert." (dolist (col (umls-file-colstructs file)) (let* ((avwaste (- (umls-col-max col) (umls-col-av col))) (cwaste (* avwaste (umls-file-rws file)))) - (unless (zerop cwaste) + (when (plusp cwaste) (if (<= avwaste 6) (progn (incf totalunavoidable cwaste) - (setq unavoidable (append unavoidable (list (list (umls-file-fil file) (umls-col-col col) avwaste cwaste))))) + (push (list (umls-file-fil file) (umls-col-col col) + avwaste cwaste) + unavoidable)) (progn (incf totalavoidable cwaste) - (setq avoidable (append avoidable (list (list (umls-file-fil file) (umls-col-col col) avwaste cwaste)))))) + (push (list (umls-file-fil file) (umls-col-col col) + avwaste cwaste) + avoidable))) (incf totalwaste cwaste))))) - (values totalwaste totalavoidable totalunavoidable avoidable unavoidable))) + (values totalwaste totalavoidable totalunavoidable + (nreverse avoidable) (nreverse unavoidable)))) (defun display-waste () (unless *umls-files* diff --git a/sql.lisp b/sql.lisp index b856e6b..671e321 100644 --- a/sql.lisp +++ b/sql.lisp @@ -4,10 +4,10 @@ ;;;; ;;;; Name: sql.lisp ;;;; Purpose: Low-level SQL routines data for UMLisp -;;;; Programmer: Kevin M. Rosenberg +;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: sql.lisp,v 1.10 2002/12/23 21:59:44 kevin Exp $ +;;;; $Id: sql.lisp,v 1.11 2003/05/06 02:14:59 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -16,9 +16,7 @@ ;;;; as governed by the terms of the GNU General Public License. ;;;; ************************************************************************* -(in-package :umlisp) -(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))) - +(in-package #:umlisp) (defvar *umls-sql-db* "KUMLS2003AA") (defun umls-sql-db () @@ -57,8 +55,9 @@ (defun sql-connect () "Connect to UMLS database, automatically used pooled connections" - (clsql:connect `(,(umls-sql-host) ,(umls-sql-db) ,(umls-sql-user) ,(umls-sql-passwd)) - :database-type *umls-sql-type* :pool t)) + (clsql:connect + `(,(umls-sql-host) ,(umls-sql-db) ,(umls-sql-user) ,(umls-sql-passwd)) + :database-type *umls-sql-type* :pool t)) (defun sql-disconnect (conn) "Disconnect from UMLS database, but put connection back into pool" diff --git a/tests.lisp b/tests.lisp index 0caf623..0835436 100644 --- a/tests.lisp +++ b/tests.lisp @@ -7,7 +7,7 @@ ;;;; Author: Kevin M. Rosenberg ;;;; Date Started: May 2003 ;;;; -;;;; $Id: tests.lisp,v 1.4 2003/05/05 23:13:28 kevin Exp $ +;;;; $Id: tests.lisp,v 1.5 2003/05/06 02:14:59 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -74,8 +74,16 @@ :order '(cui asc def desc)) "select SAB,DEF from MRDEF where CUI=39 and KSRL<=2 order by CUI asc,DEF desc") - - +(deftest ui.1 (umlisp::parse-cui "C0002341") 2341) +(deftest ui.2 (umlisp::parse-lui "L0002341") 2341) +(deftest ui.3 (umlisp::parse-sui "S0000000") 0) +(deftest ui.4 (umlisp::parse-tui "T123") 123) +(deftest ui.5 (fmt-cui 2341) "C0002341") +(deftest ui.6 (fmt-lui 2341) "L0002341") +(deftest ui.7 (fmt-sui 2341) "S0002341") +(deftest ui.8 (fmt-lui 231) "T231") +(deftest ui.9 (umlisp::make-cuisui 5 11) 50000011) +(deftest ui.10 (umlisp::decompose-cuisui 50000011) 5 11) (defun f2 (&key (srl *current-srl*)) "Return list of all ucon's" diff --git a/utils.lisp b/utils.lisp index 6b9e17e..d2a5dd8 100644 --- a/utils.lisp +++ b/utils.lisp @@ -4,10 +4,10 @@ ;;;; ;;;; Name: utils.lisp ;;;; Purpose: Low-level utility functions for UMLisp -;;;; Programmer: Kevin M. Rosenberg +;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: utils.lisp,v 1.3 2003/05/02 21:49:19 kevin Exp $ +;;;; $Id: utils.lisp,v 1.4 2003/05/06 02:14:59 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -16,8 +16,11 @@ ;;;; as governed by the terms of the GNU General Public License. ;;;; ************************************************************************* -(in-package :umlisp) -(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))) +(in-package #:umlisp) + +(eval-when (:compile-toplevel) + (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))) + (declaim (inline make-cuisui make-cuilui parse-ui parse-cui)) (defmacro def-metaclass-reader (field) @@ -81,18 +84,14 @@ (defconstant +cuisui-scale+ 10000000) (defun make-cuisui (cui sui) - (declare (fixnum cui sui)) - (the integer (+ (* +cuisui-scale+ cui) sui))) + (+ (* +cuisui-scale+ cui) sui)) (defun make-cuilui (cui lui) - (declare (fixnum cui lui)) - (the integer (+ (* +cuisui-scale+ cui) lui))) + (+ (* +cuisui-scale+ cui) lui)) (defun decompose-cuisui (cuisui) - (declare (integer cuisui)) - (let* ((cui (the fixnum (truncate (/ cuisui +cuisui-scale+)))) - (sui (the fixnum (- cuisui (* cui +cuisui-scale+))))) - (values cui sui))) + "Returns the CUI and SUI of a cuisui number" + (floor cuisui cuisui +cuisui-scale+)) ;;; Lookup functions for uterms,ustr in ucons @@ -103,11 +102,7 @@ (find sui (s#str uterm) :key #'sui :test 'equal)) (defun find-ustr-in-ucon (ucon sui) - (let ((found-ustr nil)) - (dolist (uterm (s#term ucon)) - (unless found-ustr - (dolist (ustr (s#str uterm)) - (unless found-ustr - (when (string-equal sui (sui ustr)) - (setq found-ustr ustr)))))) - found-ustr)) + (dolist (uterm (s#term ucon)) + (dolist (ustr (s#str uterm)) + (when (string-equal sui (sui ustr)) + (return-from find-ustr-in-ucon ustr))))) -- 2.34.1