From 528ae99bf39b94a9e577505be14f110ac7ac0470 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Wed, 3 Jan 2007 09:21:56 +0000 Subject: [PATCH] r11441: remove old cxt classes/functions. Use new :compute-cached-value for hyperobjects --- class-support.lisp | 27 --------------------------- classes.lisp | 28 ++++------------------------ package.lisp | 7 +++---- sql-classes.lisp | 11 ----------- 4 files changed, 7 insertions(+), 66 deletions(-) diff --git a/class-support.lisp b/class-support.lisp index 3847eb5..e4f49cb 100644 --- a/class-support.lisp +++ b/class-support.lisp @@ -330,33 +330,6 @@ ((char-equal #\O c) "Other")))) - -(defgeneric cxt-ancestors (obj)) -(defmethod cxt-ancestors ((con ucon)) - (loop for term in (s#term con) - append (cxt-ancestors term))) - - -(defmethod cxt-ancestors ((term uterm)) - (loop for str in (s#str term) - append (cxt-ancestors str))) - -(defmethod cxt-ancestors ((str ustr)) - "Return the ancestory contexts of a ustr" - (let* ((anc (remove-if-not - (lambda (cxt) (string-equal "ANC" (cxl cxt))) - (s#cxt str))) - (num-contexts (if anc - (apply #'max (mapcar (lambda (cxt) (cxn cxt)) anc)) - 0)) - (anc-lists '())) - (dotimes (i num-contexts (nreverse anc-lists)) - (let* ((anc-this-cxn (remove-if-not - (lambda (cxt) (= (1+ i) (cxn cxt))) anc))) - (push - (sort anc-this-cxn (lambda (a b) (< (rank a) (rank b)))) - anc-lists))))) - (defun uso-unique-codes (usos) (let ((sab-codes (make-hash-table :test 'equal))) (dolist (uso usos) diff --git a/classes.lisp b/classes.lisp index 9ed9be8..d965e92 100644 --- a/classes.lisp +++ b/classes.lisp @@ -92,25 +92,6 @@ rmeta slc scc srl tfr cfr cxty ttyl atnl lat cenc curver sabin ssn scit)) -(defclass ucxt (umlsclass) - ((sab :value-type string :initarg :sab :reader sab :hyperlink find-usab-rsab) - (code :value-type string :initarg :code :reader code) - (cxn :value-type fixnum :initarg :cxn :reader cxn) - (cxl :value-type string :initarg :cxl :reader cxl) - (rank :value-type string :initarg :rank :reader rank) - (cxs :value-type cdata :initarg :cxs :reader cxs) - (cui2 :value-type fixnum :initarg :cui2 :reader cui2 :hyperlink find-ucon-cui - :print-formatter fmt-cui) - (aui2 :value-type fixnum :initarg :aui2 :reader aui2 :hyperlink find-ucon-aui - :print-formatter fmt-aui) - (hcd :value-type string :initarg :hcd :reader hcd) - (rela :value-type string :initarg :rela :reader rela) - (xc :value-type string :initarg :xc :reader xc) - (cvf :value-type string :initarg :cvf :reader cvf)) - (:metaclass hyperobject-class) - (:user-name "Context") - (:default-print-slots sab code cxn cxl hcd rela xc cui2 cxs)) - (defclass uhier (umlsclass) ((cui :value-type fixnum :initarg :cui :reader cui :hyperlink find-ucon-cui :print-formatter fmt-cui) @@ -141,8 +122,7 @@ (stt :value-type string :initarg :stt :reader stt) (suppress :value-type string :initarg :suppress :reader suppress) (s#so :reader s#so :subobject (find-uso-cuisui cui sui)) - (s#sat :reader s#sat :subobject (find-usat-ui cui lui sui)) - (s#cxt :reader s#cxt :subobject (find-ucxt-cuisui cui sui))) + (s#sat :reader s#sat :subobject (find-usat-ui cui lui sui))) (:metaclass hyperobject-class) (:user-name "String") (:default-print-slots sui stt lrl str suppress)) @@ -236,9 +216,9 @@ ((cui :value-type fixnum :initarg :cui :reader cui :print-formatter fmt-cui :hyperlink find-ucon-cui) (lrl :value-type fixnum :initarg :lrl :reader lrl - :subobject (find-lrl-cui cui)) + :compute-cached-value (find-lrl-cui cui)) (pfstr :value-type cdata :initarg :pfstr :reader pfstr - :subobject (find-pfstr-cui cui)) + :compute-cached-value (find-pfstr-cui cui)) (s#def :reader s#def :subobject (find-udef-cui cui)) (s#so :reader s#so :subobject (find-uso-cui cui)) (s#hier :reader s#hier :subobject (find-uhier-cui cui)) @@ -293,7 +273,7 @@ (:documentation "CONSO is a new concept from the RRF files. This object is a rather raw row from the MRCONSO table.") (:metaclass hyperobject-class) (:user-name "Concept") - (:default-print-slots cui lrl str sab)) + (:default-print-slots cui kcuilrl str sab)) (defclass umap (umlsclass) ((mapsetcui :value-type fixnum :initarg :mapsetcui :reader mapsetcui) diff --git a/package.lisp b/package.lisp index df3c69c..bb930ee 100644 --- a/package.lisp +++ b/package.lisp @@ -27,7 +27,7 @@ . ;; From classes.lisp #1=(#:umlsclass - #:ucon #:uterm #:ustr #:usrl #:uso #:ucxt #:urank #:udef #:usat #:usab + #:ucon #:uterm #:ustr #:usrl #:uso #:urank #:udef #:usat #:usab #:urel #:ucoc #:usty #:uxw #:uxnw #:uxns #:lexterm #:labr #:lagr #:lcmp #:lmod #:lnom #:lprn #:lprp #:lspl #:ltrm #:ltyp #:lwd #:sdef #:sstr #:sstre1 #:sstre2 @@ -37,7 +37,7 @@ #:cui #:aui #:lui #:sui #:wd #:lat #:nstr :cuilist #:rsab #:lat #:s#def #:s#sty #:s#term #:s#str #:s#lo #:s#sat #:s#rel #:s#coc - #:s#so #:s#cxt + #:s#so #:pfstr #:pfstr2 #:lrl #:def #:ts #:cui1 #:cui2 #:rela #:sl #:mg #:rel #:soc #:cot #:cof #:coa #:isn #:fr #:un #:sna #:soui #:hcd #:stt #:str #:kpfeng :cvf @@ -50,7 +50,7 @@ #:pfstr #:pf-ustr #:cui-p #:lui-p #:sui-p #:tui-p #:eui-p #:rel-abbr-info #:filter-urels-by-rel - #:mesh-number #:cxt-ancestors #:ucon-ustrs + #:mesh-number #:ucon-ustrs #:lat-abbr-info #:stt-abbr-info #:uso-unique-codes #:ucon-has-sab @@ -110,7 +110,6 @@ #:find-uso-cuisui #:find-uso-cui #:find-uso-aui - #:find-ucxt-cuisui #:find-usat-ui #:find-usab-all #:find-usab-rsab diff --git a/sql-classes.lisp b/sql-classes.lisp index a407364..5983f7c 100644 --- a/sql-classes.lisp +++ b/sql-classes.lisp @@ -598,17 +598,6 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" :sui sui :saui saui :sdui sdui :scui scui :lat lat :str str))) -(defun find-ucxt-cuisui (cui sui &key (srl *current-srl*)) - (ensure-cui-integer cui) - (ensure-sui-integer sui) - (collect-umlisp-query (mrcxt (sab rank code cxn cxl cxs cui2 hcd rela xc) - srl kcuisui (make-cuisui cui sui) :lrl ksrl) - (make-instance 'ucxt :sab sab :code code - :rank rank - :cxn (ensure-integer cxn) :cxl cxl :cxs cxs :hcd hcd - :rela rela :xc xc - :cui2 (ensure-integer cui2)))) - (defun find-uhier-cui (cui &key (srl *current-srl*)) (ensure-cui-integer cui) (collect-umlisp-query (mrhier (aui cxn paui sab rela ptr hcd cvf) -- 2.34.1