-;;; $Id: classes.lisp,v 1.2 2002/10/09 02:23:22 kevin Exp $
-;;;
-;;; UMLS object defintions and printing routines
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: classes.lisp
+;;;; Purpose: Class defintions for UMLisp
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Apr 2000
+;;;;
+;;;; $Id: classes.lisp,v 1.3 2002/10/09 23:03:41 kevin Exp $
+;;;;
+;;;; This file, part of UMLisp, is
+;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
+;;;;
+;;;; UMLisp users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the GNU General Public License.
+;;;; *************************************************************************
(in-package :umlisp)
-(declaim (optimize (speed 3) (safety 1)))
+(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3)))
(defclass umlsclass ()
()
- (:metaclass kmrcl::ml-class)
- (:documentation "Parent class of all UMLS objects"))
+ (:metaclass kmrcl:ml-class)
+ (:documentation "Parent class of all UMLS objects. It is based on the KMRCL:ML-CLASS metaclass that provides object printing functions."))
(defmethod print-object ((obj umlsclass) (s stream))
(funcall (funcall (kmrcl::obj-data-value-func fmt) obj) obj))))))
-
-
(defclass urank (umlsclass)
((rank :type fixnum :initarg :rank :reader rank)
(sab :type string :initarg :sab :reader sab)
(tty :type string :initarg :tty :reader tty)
(supres :type string :initarg :supres :reader supres))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :rank nil :sab nil :tty nil :supres nil)
(:title "Rank")
(:fields (rank :fixnum) (sab :string) (tty :string) (supres :string)))
(defclass udef (umlsclass)
((def :type string :initarg :def :reader def)
(sab :type string :initarg :sab :reader sab))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :def nil :sab nil)
(:title "Definition")
(:ref-fields (sab find-bsab-sab))
(code :type string :initarg :code :reader code)
(atn :type string :initarg :atn :reader atn)
(atv :type string :initarg :atv :reader atv))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :sab nil :code nil :atn nil :atv nil)
(:title "Simple Attribute")
(:ref-fields (sab find-bsab-sab))
(code :type string :initarg :code :reader code)
(tty :type string :initarg :tty :reader tty)
(srl :type fixnum :initarg :srl :reader srl))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :sab nil :code nil :tty nil :srl nil)
(:title "Source")
(:ref-fields (sab find-bsab-sab) (tty find-btty-tty))
(hcd :type string :initarg :hcd :reader hcd)
(rela :type string :initarg :rela :reader rela)
(xc :type string :initarg :xc :reader xc))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :sab nil :code nil :rnk nil :cxn nil :cxl nil :cxs nil
:cui2 nil :hcd nil :rela nil :xc nil)
(:title "Context")
(s#sat :reader s#sat)
(s#so :reader s#so)
(s#cxt :reader s#cxt))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs
:sui nil :cui nil :lui nil :cuisui nil :str nil :lrl nil :stt nil)
(:title "String")
(sui :type fixnum :initarg :sui :reader sui)
(sna :type string :initarg :sna :reader sna)
(soui :type string :initarg :soui :reader soui))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :isn nil :fr nil :un nil :sui nil :sna nil :soui nil)
(:title "Locator")
(:fields (isn :string) (fr :fixnum) (un :string) (sna :string)
(lrl :type fixnum :initarg :lrl :reader lrl)
(s#str :reader s#str)
(s#sat :reader s#sat))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :lui nil :cui nil :lat nil :ts nil :lrl nil)
(:title "Term")
(:subobjects-lists (s#sat usat) (s#str ustr))
(defclass usty (umlsclass)
((tui :type fixnum :initarg :tui :reader tui)
(sty :type string :initarg :sty :reader sty))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :tui nil :sty nil)
(:title "Semantic Type")
(:ref-fields (tui find-ucon-tui (("subobjects" "no"))))
(sab :type string :initarg :sab :reader sab)
(sl :type string :initarg :sl :reader sl)
(mg :type string :initarg :mg :reader mg))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs
:rel nil :cui1 nil :cui2 nil :pfstr2 nil :rela nil :sab nil :sl nil :mg nil)
(:title "Relationship")
(cot :type string :initarg :cot :reader cot)
(cof :type fixnum :initarg :cof :reader cof)
(coa :type string :initarg :coa :reader coa))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs
:cui1 nil :cui2 nil :pfstr2 nil :soc nil :cot nil :cof nil :coa nil)
(:title "Co-occuring Concept")
((sab :type string :initarg :sab :reader sab)
(rel :type string :initarg :rel :reader rel)
(atx :type string :initarg :atx :reader atx))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :sab nil :rel nil :atx nil)
(:title "Associated Expression")
(:fields (sab :string) (rel :string) (atx :cdata)))
(s#sat :reader s#sat)
(s#atx :reader s#atx)
(s#sty :reader s#sty))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :cui nil :pfstr nil :lrl nil)
(:title "Concept")
(:subobjects-lists
(cui :type fixnum :initform nil :initarg :cui :reader cui)
(lui :type fixnum :initform nil :initarg :lui :reader lui)
(sui :type fixnum :initform nil :initarg :sui :reader sui))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :wd nil :cui nil :lui nil :sui nil)
(:title "XW Index")
(:fields (wd :string) (cui :string fmt-cui) (lui :string fmt-lui)
((lat :type string :initarg :lat :reader lat)
(nwd :type string :initarg :nwd :reader nwd)
(cuilist :type list :initarg :cuilist :reader uxnw-cuilist))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :lat nil :nwd nil :cuilist nil)
(:title "XNW Index")
(:fields (lat :string) (nwd :string) (cuilist :string)))
((lat :type string :initarg :lat :reader lat)
(nstr :type string :initarg :nstr :reader nstr)
(cuilist :type list :initarg :cuilist :reader cuilist))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :lat nil :nstr nil :cuilist nil)
(:title "XNS Index")
(:fields (lat :string) (nstr :string) (cuilist :string)))
(s#spl :reader s#spl)
(s#trm :reader s#trm)
(s#typ :reader s#typ))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :eui nil :wrd nil)
(:title "Lexical Term")
(:subobjects-lists
(abr :type string :initarg :abr :reader abr)
(eui2 :type integer :initarg :eui2 :reader eui2)
(bas2 :type string :initarg :bas2 :reader bas2))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :eui nil :bas nil :abr nil :eui2 nil :bas2 nil)
(:title "Abbreviations and Acronyms")
(:fields (eui :string fmt-eui) (bas :string) (abr :string)
(agr :type string :initarg :agr :reader agr)
(cit :type string :initarg :cit :reader cit)
(bas :type string :initarg :bas :reader bas))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :eui nil :str nil :sca nil :agr nil :cit nil :bas nil)
(:title "Agreement and Inflection")
(:fields (eui :string fmt-eui) (str :string) (sca :string) (agr :string)
(bas :type string :initarg :bas :reader bas)
(sca :type string :initarg :sca :reader sca)
(com :type string :initarg :com :reader com))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :eui nil :bas nil :sca nil :com nil)
(:title "Complementation")
(:fields (eui :string fmt-eui) (bas :string) (sca :string) (com :string)))
(sca :type string :initarg :sca :reader sca)
(psnmod :type string :initarg :psnmod :reader psnmod)
(fea :type string :initarg :fea :reader fea))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :eui nil :bas nil :sca nil :psnmod nil :fea nil)
(:title "Modifiers")
(:fields (eui :string fmt-eui) (bas :string) (sca :string) (psnmod :string)
(eui2 :type integer :initarg :eui2 :reader eui2)
(bas2 :type string :initarg :bas2 :reader bas2)
(sca2 :type string :initarg :sca2 :reader sca2))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :eui nil :bas nil :sca nil :eui2 nil :bas2 nil :sca2 nil)
(:title "Nominalizations")
(:fields (eui :string fmt-eui) (bas :string) (sca :string)
(pos :type string :initarg :pos :reader pos)
(qnt :type string :initarg :qnt :reader qnt)
(fea :type string :initarg :fea :reader fea))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :eui nil :bas nil :num nil :gnd nil :cas nil
:pos nil :qnt nil :fea nil)
(:title "Pronouns")
(str :type string :initarg :str :reader str)
(sca :type string :initarg :sca :reader sca)
(fea :type string :initarg :fea :reader fea))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :eui nil :bas nil :str nil :sca nil :fea nil)
(:title "Properties")
(:fields (eui :string fmt-eui) (bas :string) (str :string) (sca :string)
((eui :type integer :initarg :eui :reader eui)
(spv :type string :initarg :spv :reader spv)
(bas :type string :initarg :bas :reader bas))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :eui nil :spv nil :bas nil)
(:title "Spelling Variants")
(:fields (eui :string fmt-eui) (spv :string) (bas :string)))
((eui :type integer :initarg :eui :reader eui)
(bas :type string :initarg :bas :reader bas)
(gen :type string :initarg :gen :reader gen))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :eui nil :bas nil :gen nil)
(:title "Trade Marks")
(:fields (eui :string fmt-eui) (bas :string) (gen :string)))
(bas :type string :initarg :bas :reader bas)
(sca :type string :initarg :sca :reader sca)
(typ :type string :initarg :typ :reader typ))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :eui nil :bas nil :sca nil :typ nil)
(:title "Inflection Type")
(:fields (eui :string fmt-eui) (bas :string) (sca :string) (typ :string)))
(defclass lwd (umlsclass)
((wrd :type string :initarg :wrd :reader wrd)
(euilist :type list :initarg :euilist :reader euilist))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :wrd nil :euilist nil)
(:title "Lexical Word Index")
(:fields (wrd :string) (euilist :string)))
(rh :type string :initarg :rh :reader rh)
(abr :type string :initarg :abr :reader abr)
(rin :type string :initarg :rin :reader rin))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs
:rt nil :ui nil :styrl nil :stnrtn nil :def nil :ex nil :un nil :rh nil
:abr nil :rin nil)
(rl :type string :initarg :rl :reader rl)
(styrl2 :type string :initarg :styrl2 :reader styrl2)
(ls :type string :initarg :ls :reader ls))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :styrl nil :rl nil :styrl2 nil :ls nil)
(:title "Structure of the Network")
(:fields (styrl :string) (rl :string) (styrl2 :string) (ls :string)))
((ui :type integer :initarg :ui :reader ui)
(ui2 :type integer :initarg :ui2 :reader ui2)
(ui3 :type integer :initarg :ui3 :reader ui3))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :ui nil :ui2 nil :ui3 nil)
(:title "Fully Inherited Set of Releatons (TUI's)")
(:fields (ui :string fmt-tui) (ui2 :string fmt-tui) (ui3 :string fmt-tui)))
((sty :type string :initarg :ui :reader sty)
(rl :type string :initarg :ui2 :reader rl)
(sty2 :type string :initarg :ui3 :reader sty2))
- (:metaclass kmrcl::ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :sty nil :rl nil :sty2 nil)
(:title "Fully Inherited Set of Releatons (strings)")
(:fields (sty :string) (rl :string) (sty2 :string)))
-;;;; $Id: composite.lisp,v 1.2 2002/10/09 00:34:47 kevin Exp $
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: composite.lisp
+;;;; Purpose: Composite Classes for UMLisp
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Apr 2000
+;;;;
+;;;; $Id: composite.lisp,v 1.3 2002/10/09 23:03:41 kevin Exp $
+;;;;
+;;;; This file, part of UMLisp, is
+;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
+;;;;
+;;;; UMLisp users are granted the rights to distribute and use this software
+;;;; 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)))
;;; Semantic type constants
(defclass ucon_freq (umlsclass)
((ucon :type ucon :initarg :ucon :reader ucon)
(freq :type fixnum :initarg :freq :accessor freq))
- (:metaclass ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :cui nil :pfstr nil :freq nil)
(:title "Concept and Count")
(:fields (cui :string fmt-cui) (freq :fixnum) (pfstr :cdata))
(defclass ustr_freq (umlsclass)
((ustr :type ustr :initarg :ustr :reader ustr)
(freq :type fixnum :initarg :freq :accessor freq))
- (:metaclass ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :cui nil :pfstr nil :freq nil)
(:title "String and Count")
(:fields (sui :string fmt-sui) (freq :fixnum) (stt :string) (lrl :fixnum) (str :cdata))
(defclass usty_freq (umlsclass)
((usty :type usty :initarg :usty :reader usty)
(freq :type fixnum :initarg :freq :accessor freq))
- (:metaclass ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :usty nil :freq nil)
(:title "Semantic Type and Count")
(:ref-fields (tui find-ucon-tui "subobjects=no"))
(defclass usrl_freq (umlsclass)
((usrl :type usrl :initarg :usrl :reader usrl)
(freq :type fixnum :initarg :freq :accessor freq))
- (:metaclass ml-class)
+ (:metaclass kmrcl:ml-class)
(:default-initargs :usrl nil :freq nil)
(:title "Source and Count")
(:ref-fields (sab find-ustr-sab))
-;;;; $Id: data-structures.lisp,v 1.2 2002/10/09 00:34:47 kevin Exp $
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: data-structures.lisp
+;;;; Purpose: Basic data objects for UMLisp
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Apr 2000
+;;;;
+;;;; $Id: data-structures.lisp,v 1.3 2002/10/09 23:03:41 kevin Exp $
+;;;;
+;;;; This file, part of UMLisp, is
+;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
+;;;;
+;;;; UMLisp users are granted the rights to distribute and use this software
+;;;; 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)))
;;; Paths for files
-;;;; $Id: package.lisp,v 1.3 2002/10/09 02:23:22 kevin Exp $
-;;;;
-;;;; Package definition for UMLisp
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: cl-user -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: package.lisp
+;;;; Purpose: Package definition for UMLisp
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Apr 2000
+;;;;
+;;;; $Id: package.lisp,v 1.4 2002/10/09 23:03:41 kevin Exp $
+;;;;
+;;;; This file, part of UMLisp, is
+;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
+;;;;
+;;;; UMLisp users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the GNU General Public License.
+;;;; *************************************************************************
(in-package :cl-user)
(defpackage umlisp
(:nicknames :u)
(:export
+
+ ;; From classes.lisp
+ #:umlsclass
#:ucon
#:uterm
#:ustr
+ #:sty
+ #:tui
+
+ ;; From sql.lisp
+ #:umls-sql-user!
+ #:umls-sql-passwd!
+ #:with-sql-connection
+ #:mutex-sql-execute
+ #:mutex-sql-query
+ #:sql-query
+ #:sql-execute
+
+ ;; From utils.lisp
+ #:fmt-cui
+ #:fmt-lui
+ #:fmt-sui
+ #:fmt-tui
+
+ #:*current-srl*
+
+ ;; From sql-classes.lisp
+
#:find-udef-cui
#:find-usty-cui
#:find-usty-word
- ;;; UMLS-Parse
-;;; Lisp Routines for parsing UMLS files
-;;; and inserting into SQL databases
-;;;
-;;; Copyright (c) 2001 Kevin M. Rosenberg, M.D.
-;;; $Id: parse-2002.lisp,v 1.2 2002/10/09 00:34:47 kevin Exp $
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: parse-2002.lisp
+;;;; Purpose: Parsing and SQL insertion routines for UMLisp which may
+;;;; change from year to year
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Apr 2000
+;;;;
+;;;; $Id: parse-2002.lisp,v 1.3 2002/10/09 23:03:41 kevin Exp $
+;;;;
+;;;; This file, part of UMLisp, is
+;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
+;;;;
+;;;; UMLisp users are granted the rights to distribute and use this software
+;;;; 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)))
;;; Pre-read data for custom fields into hash tables
(defvar *parse-hash-init?* nil)
-;;; UMLS-Parse General
-;;; General purpose Lisp Routines for parsing UMLS files
-;;; and inserting into SQL databases
-;;;
-;;; Copyright (c) 2001 Kevin M. Rosenberg, M.D.
-;;; $Id: parse-common.lisp,v 1.1 2002/10/05 20:17:14 kevin Exp $
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: parse-common.lisp
+;;;; Purpose: Common, stable parsing routines for UMLisp
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Apr 2000
+;;;;
+;;;; $Id: parse-common.lisp,v 1.2 2002/10/09 23:03:41 kevin Exp $
+;;;;
+;;;; This file, part of UMLisp, is
+;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
+;;;;
+;;;; UMLisp users are granted the rights to distribute and use this software
+;;;; 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)))
(defun umls-pathname (filename &optional (extension ""))
"Return pathname for a umls filename"
-;;; UMLS-Parse General
-;;; General purpose Lisp Routines for parsing UMLS files
-;;; and inserting into SQL databases
-;;;
-;;; Copyright (c) 2001 Kevin M. Rosenberg, M.D.
-;;; $Id: parse-macros.lisp,v 1.1 2002/10/05 20:17:14 kevin Exp $
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: parse-macros.lisp
+;;;; Purpose: Macros for UMLS file parsing
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Apr 2000
+;;;;
+;;;; $Id: parse-macros.lisp,v 1.2 2002/10/09 23:03:41 kevin Exp $
+;;;;
+;;;; This file, part of UMLisp, is
+;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
+;;;;
+;;;; UMLisp users are granted the rights to distribute and use this software
+;;;; 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)))
(defmacro with-umls-file ((line filename) &body body)
-;;; $Id: sql-classes.lisp,v 1.2 2002/10/09 00:34:47 kevin Exp $
-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: sql-classes.lisp
+;;;; Purpose: Routines for reading UMLS objects from SQL database
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Apr 2000
+;;;;
+;;;; $Id: sql-classes.lisp,v 1.3 2002/10/09 23:03:41 kevin Exp $
+;;;;
+;;;; This file, part of UMLisp, is
+;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
+;;;;
+;;;; UMLisp users are granted the rights to distribute and use this software
+;;;; 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)))
-(declaim (optimize (speed 3) (safety 1)))
(defvar *current-srl* nil)
(defun current-srl ()
(setq ucons (append ucons (find-ucon-word word :srl srl))))
(sort-score-ucon-str str (delete-duplicates ucons :test #'eql :key #'cui))))
-(defun find-ucon-normalized-multiword (str &key (srl *current-srl*))
- "Return sorted list of ucon's that match a multiword string"
- (let* ((words (delimited-string-to-list str #\space))
- (ucons '())
- (nwords '()))
- (dolist (word words)
- (let ((nws (lvg:process-terms word)))
- (dolist (nword nws)
- (push nword nwords))))
- (dolist (word nwords)
- (setq ucons (append ucons (find-ucon-word word :srl srl))))
- (sort-score-ucon-str str (delete-duplicates ucons :test #'eql :key #'cui))))
-
(defun find-ustr-multiword (str &key (srl *current-srl*))
"Return sorted list of ustr's that match a multiword string"
(let* ((words (delimited-string-to-list str #\space))
(dolist (word words)
(setq ustrs (append ustrs (find-ustr-word word :srl srl))))
(sort-score-ustr-str str (delete-duplicates ustrs :test #'eql :key #'cui))))
-
-(defun find-ustr-normalized-multiword (str &key (srl *current-srl*))
- "Return sorted list of ustr's that match a multiword string"
- (let* ((words (delimited-string-to-list str #\space))
- (ustrs '())
- (nwords '()))
- (dolist (word words)
- (let ((nws (lvg:process-terms word)))
- (dolist (nword nws)
- (push nword nwords))))
- (dolist (word nwords)
- (setq ustrs (append ustrs (find-ustr-word word :srl srl))))
- (sort-score-ustr-str str (delete-duplicates ustrs :test #'eql :key #'ustr-cui))))
-
-(defun a (str)
- (find-normalized-matches-for-str str #'find-ustr-normalized-word #'ustr-sui))
-
-(defun find-normalized-matches-for-str (str lookup-func key-func)
- "Return list of objects that normalize match for words in string,
-eliminate duplicates."
- (let ((objs '())
- (nwords '()))
- (dolist (word (delimited-string-to-list str #\space))
- (dolist (nword (lvg:process-terms word))
- (unless (member nword nwords :test #'string-equal)
- (push nword nwords))))
- (dolist (nw nwords)
- (setq objs (append objs (funcall lookup-func nw))))
- (delete-duplicates objs :key key-func :test #'eql)))
(defun sort-score-ucon-str (str ucons)
"Return list of sorted and scored ucons. Score by match of str to ucon-pfstr"
-;;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Pkg: umlisp -*-
-;; SQL/UMLS database Layer over database backend
-;; Copyright (c) 2001 Kevin M. Rosenberg, M.D.
-;; $Id: sql.lisp,v 1.2 2002/10/08 22:13:41 kevin Exp $
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: sql.lisp
+;;;; Purpose: Low-level SQL routines data for UMLisp
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Apr 2000
+;;;;
+;;;; $Id: sql.lisp,v 1.3 2002/10/09 23:03:41 kevin Exp $
+;;;;
+;;;; This file, part of UMLisp, is
+;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
+;;;;
+;;;; UMLisp users are granted the rights to distribute and use this software
+;;;; 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)))
-(declaim (optimize (speed 1) (safety 3)))
(defvar *umls-sql-dsn* "KUMLS2002AC")
(defun umls-sql-dsn ()
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; $Id: umlisp.asd,v 1.3 2002/10/09 00:34:47 kevin Exp $
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: umlisp.asd
+;;;; Purpose: ASDF system definition file for UMLisp
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Apr 2000
+;;;;
+;;;; $Id: umlisp.asd,v 1.4 2002/10/09 23:03:41 kevin Exp $
+;;;;
+;;;; This file, part of UMLisp, is
+;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
+;;;;
+;;;; UMLisp users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the GNU General Public License.
+;;;; *************************************************************************
(in-package :asdf)
-;;;; $Id: utils.lisp,v 1.1 2002/10/05 20:17:14 kevin Exp $
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: utils.lisp
+;;;; Purpose: Low-level utility functions for UMLisp
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Apr 2000
+;;;;
+;;;; $Id: utils.lisp,v 1.2 2002/10/09 23:03:41 kevin Exp $
+;;;;
+;;;; This file, part of UMLisp, is
+;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
+;;;;
+;;;; UMLisp users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the GNU General Public License.
+;;;; *************************************************************************
(in-package :umlisp)
-
-(declaim (inline xml-cdata make-cuisui make-cuilui parse-ui parse-cui))
-(declaim (optimize (speed 3) (safety 1)))
+(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)
"Create function for reading slot of metaclass"
(parse-integer eui)))
eui))
-(defun xml-cdata (str)
- (concatenate 'string "<![CDATA[" str "]]>"))
-
(defconstant +cuisui-scale+ 10000000)
(defun make-cuisui (cui sui)
projects / umlisp.git / commitdiff