+ ;; (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)))
+
+
+(defun find-minimum-distance (anc1 anc2 &key (distance 0) (minimum 0) path)
+ (cond
+ ((or (null anc1) (null anc2) nil))
+ ((and (atom (car anc1)) (atom (car anc2)))
+ (when (eql (cui ucon1) (cui ucon2))
+ (return-from find-minimum-distance (values distance path)))
+ (incf distance)
+ (when (> distance minimum)
+ (return-from find-minimum-distance nil))
+ (multiple-value-bind (dist1 path1)
+ (find-minimum-distance anc1 (cdr anc2)
+ :distance distance :minimum minimum
+ :path (list* anc1 path))
+ (when (and dist1 (< dist1 minimum))
+ (setf minimum dist1
+ path path1)))
+ (multiple-value-bind (dist2 path2)
+ (find-minimum-distance (cdr anc1) anc2
+ :distance distance :minimum minimum
+ :path (list* anc2 path))
+ (when (and dist2 (< dist2 minimum))
+ (setf minimum dist2
+ path path2)))
+ (return-from find-minimum-distance (values distance path))
+
+
+ (min2 (find-minimum-distance
+ (cdr anc1) anc2
+ :distance distance :minimum minimum
+ :path (list* anc2 path)))
+ (when (and min2 (< min2 minimum))
+ (setf minimum min2
+ path (list* anc2 path))))))
+
+
+
+(defun ucon-cdist (ucon1 ucon2 &key include-rb sab)
+ "Compute James Cimino's CDist metric"
+ (let ((anc1 (ucon-ancestors ucon1 :include-rb include-rb :sab sab))
+ (anc2 (ucon-ancestors ucon2 :include-rb include-rb :sab sab)))
+ (find-minimum-distance (list ucon1 anc1) (list ucon2 anc2))))
+