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