X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=class-support.lisp;h=69983a621434a642ecb603a6ee7b65a95b755bc2;hb=08af5459d3ba7d229a8339d242ef742cfe846861;hp=1d3f96d0902ba0a5f909812b154af04f8d9948c8;hpb=61a8511de3b01b68d68b75331ffa67c362a6fe19;p=umlisp.git

diff --git a/class-support.lisp b/class-support.lisp
index 1d3f96d..69983a6 100644
--- a/class-support.lisp
+++ b/class-support.lisp
@@ -336,106 +336,6 @@
 	  "Other"))))
 
 
-(defun ucon-parents (ucon &key sab include-rb)
-  (ucon-ancestors ucon :sab sab :include-rb include-rb
-                  :ancestors nil))
-
-(defun is-ucon-in-ancestors (ucon ancestors)
-  (cond
-   ((null ancestors) nil)
-   ((atom ancestors) (eql (cui ucon) (cui ancestors)))
-   ((listp (car ancestors))
-    (or (is-ucon-in-ancestors ucon (car ancestors))
-        (is-ucon-in-ancestors ucon (cdr ancestors))))
-   (t
-    (or (eql (cui ucon) (cui (car ancestors)))
-        (is-ucon-in-ancestors ucon (cdr ancestors))))))
-
-
-(defun sorted-ancestor-cuis (anc)
-  (sort (remove-duplicates (map 'list 'cui (flatten anc))) #'<))
-
-(defun shared-cuis (a1 a2)
-  (let ((cl1 (sorted-ancestor-cuis a1))
-        (cl2 (sorted-ancestor-cuis a2))
-        (shared nil))
-    (dolist (c1 cl1 (nreverse shared))
-      (dolist (c2 cl2)
-        (cond
-         ((eql c1 c2)
-          (push c1 shared))
-         ((> c2 c1)
-          (return)))))))
-
-(defun cdist-ancestors (anc1 anc2)
-  (let ((shareds (shared-cuis anc1 anc2)))
-    (let ((min most-positive-fixnum)
-          (cui-min nil))
-      (declare (fixnum min))
-      (dolist (shared shareds)
-        (let* ((d1 (ancestor-distance shared anc1))
-               (d2 (ancestor-distance shared anc2))
-               (dtotal (+ d1 d2)))
-          (declare (fixnum d1 d2 dtotal))
-          (when (< dtotal min)
-            (setq min dtotal
-                  cui-min shared))))
-      (values min cui-min))))
-
-(defun cdist (c1 c2 &key sab include-rb)
-  (let* ((anc1 (ucon-ancestors c1 :sab sab :include-rb include-rb))
-         (anc2 (ucon-ancestors c2 :sab sab :include-rb include-rb)))
-    (multiple-value-bind (min cui)
-        (cdist-ancestors anc1 anc2)
-      (if cui
-          (values min cui)
-        (values nil nil)))))
-               
-
-(defun ancestor-distance (cui ancestors &key (distance 0))
-  (cond
-   ((null ancestors)
-    nil)
-   ((atom ancestors)
-    (when (eql cui (cui ancestors))
-      distance))
-   ((atom (car ancestors))
-    (if (eql cui (cui (car ancestors)))
-        distance
-      (ancestor-distance cui (cdr ancestors) :distance distance)))
-   (t
-    (let ((min most-positive-fixnum))
-      (dolist (a ancestors)
-        (let ((d (ancestor-distance cui a :distance (1+ distance))))
-          (when (and d (< d min))
-            (setq min d))))
-      (when (< min most-positive-fixnum)
-        min)))))
-
-    
-        
-(defun ucon-ancestors (ucon &key sab include-rb ancestors)
-  "Returns a list of ancestor lists for a concept"
-  (let* ((parent-rels (append (filter-urels-by-rel (s#rel ucon) "par")
-                              (when include-rb
-                                (filter-urels-by-rel (s#rel ucon) "rb"))))
-         (parents nil))
-    (when sab
-      (setq parent-rels (delete-if-not
-			 (lambda (rel) (string-equal sab (sab rel)))
-			 parent-rels)))
-    (dolist (rel parent-rels)
-      (let ((parent (find-ucon-cui (cui2 rel))))
-        ;;(format t "~S ~S ~S ~S~%" rel ucon parent ancestors)
-        (unless (is-ucon-in-ancestors parent ancestors)
-          (push
-           (list*
-            parent
-            (ucon-ancestors parent :sab (sab rel) :ancestors (append (list parent) ancestors)))
-           parents))))
-    (nreverse parents)))
-
-
 (defgeneric cxt-ancestors (obj))
 (defmethod cxt-ancestors ((con ucon))
   (loop for term in (s#term con)
@@ -469,7 +369,6 @@
     (loop for key being the hash-key in sab-codes
         collect (list key (gethash key sab-codes)))))
 
-
 (defun ucon-has-sab (ucon sab)
   (and (find-if (lambda (uso) (string-equal sab (sab uso))) (s#so ucon)) t))