r11441: remove old cxt classes/functions. Use new :compute-cached-value for hyperobjects

diff --git a/class-support.lisp b/class-support.lisp
index 3847eb5ef2813d876b4e41be5b76692a7ac20f4f..e4f49cbcedeb36749d18008bfc56036fbd937dc7 100644 (file)
--- a/class-support.lisp
+++ b/class-support.lisp
@@ -330,33 +330,6 @@
         ((char-equal #\O c)
          "Other"))))
 
         ((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)
 (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 9ed9be8388f4d499e8097c98964efc55edfcd3d7..d965e92baa8febf1120eca4306e2982e405e2d3c 100644 (file)
--- 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))
 
                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)
 (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))
    (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))
   (: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
   ((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
    (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))
    (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")
   (: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)
 
 (defclass umap (umlsclass)
   ((mapsetcui :value-type fixnum :initarg :mapsetcui :reader mapsetcui)

diff --git a/package.lisp b/package.lisp
index df3c69c8a1f5c0ae64720f37ae5828e0b50c136c..bb930ee6c592553eacb24895b1114168f67a7666 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -27,7 +27,7 @@
    .
    ;; From classes.lisp
    #1=(#:umlsclass
    .
    ;; 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
        #: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
        #: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
        #: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
    #: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
 
    #: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-uso-cuisui
    #:find-uso-cui
    #:find-uso-aui

-   #:find-ucxt-cuisui

    #:find-usat-ui
    #:find-usab-all
    #:find-usab-rsab
    #:find-usat-ui
    #:find-usab-all
    #:find-usab-rsab

diff --git a/sql-classes.lisp b/sql-classes.lisp
index a407364012b868e02371b61856717e7e7c2a2f07..5983f7c9cecfc80fccc308be45ac1acc64284a7c 100644 (file)
--- 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)))
 
                   :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)
 (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)