-(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))))
-
-