utils.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          utils.lisp
   6 ;;;; Purpose:       Low-level utility functions for UMLisp
   7 ;;;; Author:        Kevin M. Rosenberg
   8 ;;;; Date Started:  Apr 2000
   9 ;;;;
  10 ;;;; $Id: utils.lisp,v 1.4 2003/05/06 02:14:59 kevin Exp $
  11 ;;;;
  12 ;;;; This file, part of UMLisp, is
  13 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
  14 ;;;;
  15 ;;;; UMLisp users are granted the rights to distribute and use this software
  16 ;;;; as governed by the terms of the GNU General Public License.
  17 ;;;; *************************************************************************
  18
  19 (in-package #:umlisp)
  20
  21 (eval-when (:compile-toplevel)
  22   (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))))
  23
  24 (declaim (inline make-cuisui make-cuilui parse-ui parse-cui))
  25
  26 (defmacro def-metaclass-reader (field)
  27   "Create function for reading slot of metaclass"
  28   `(defun ,field (cl)
  29      (car (slot-value (class-of cl) ',field))))
  30
  31 (defmacro def-metaclass-reader-car (field)
  32   "Create function for reading slot of metaclass"
  33   `(defun ,field (cl)
  34      (car (slot-value (class-of cl) ',field))))
  35
  36 ;;; Field transformations
  37
  38 (defun parse-ui (s &optional (nullvalue 0))
  39   "Return integer value for a UMLS unique identifier."
  40   (if (< (length s) 2)
  41       nullvalue
  42     (parse-integer s :start 1)))
  43
  44 (defun parse-cui (cui)
  45   (if (stringp cui)
  46       (let ((ch (aref cui 0)))
  47         (if (eql ch #\C)
  48             (parse-ui cui)
  49           (parse-integer cui)))
  50     cui))
  51
  52 (defun parse-lui (lui)
  53   (if (stringp lui)
  54       (let ((ch (aref lui 0)))
  55         (if (eql ch #\L)
  56             (parse-ui lui)
  57           (parse-integer lui)))
  58     lui))
  59
  60 (defun parse-sui (sui)
  61   (if (stringp sui)
  62       (let ((ch (aref sui 0)))
  63         (if (eql ch #\S)
  64             (parse-ui sui)
  65           (parse-integer sui)))
  66     sui))
  67
  68 (defun parse-tui (tui)
  69   (if (stringp tui)
  70       (let ((ch (aref tui 0)))
  71         (if (eql ch #\T)
  72             (parse-ui tui)
  73           (parse-integer tui)))
  74     tui))
  75
  76 (defun parse-eui (eui)
  77   (if (stringp eui)
  78       (let ((ch (aref eui 0)))
  79         (if (eql ch #\E)
  80             (parse-ui eui)
  81           (parse-integer eui)))
  82     eui))
  83
  84 (defconstant +cuisui-scale+ 10000000)
  85
  86 (defun make-cuisui (cui sui)
  87   (+ (* +cuisui-scale+ cui) sui))
  88
  89 (defun make-cuilui (cui lui)
  90   (+ (* +cuisui-scale+ cui) lui))
  91
  92 (defun decompose-cuisui (cuisui)
  93   "Returns the CUI and SUI of a cuisui number"
  94   (floor cuisui cuisui +cuisui-scale+))
  95
  96 ;;; Lookup functions for uterms,ustr in ucons
  97
  98 (defun find-uterm-in-ucon (ucon lui)
  99   (find lui (s#term ucon) :key #'lui :test 'equal))
 100
 101 (defun find-ustr-in-uterm (uterm sui)
 102   (find sui (s#str uterm) :key #'sui :test 'equal))
 103
 104 (defun find-ustr-in-ucon (ucon sui)
 105   (dolist (uterm (s#term ucon))
 106     (dolist (ustr (s#str uterm))
 107       (when (string-equal sui (sui ustr))
 108         (return-from find-ustr-in-ucon ustr)))))