depth.ss

;;; 家系図を構成する人達

(define Harry (make-hasheq))
(define Jane (make-hasheq))
(define Joe (make-hasheq))
(define Diane (make-hasheq))
(define Bill (make-hasheq))
(define Julia (make-hasheq))
(define Frank (make-hasheq))
(define Anne (make-hasheq))
(define Susan (make-hasheq))
(define Mike (make-hasheq))

;;; 系図の構成

(hash-set! Harry 'children `(,Jane ,Bill))
(hash-set! Jane 'children `(,Joe ,Diane))
(hash-set! Bill 'children `(,Julia ,Mike))
(hash-set! Julia 'children `(,Frank ,Susan))
(hash-set! Frank 'children `(,Anne))

;;; 深さ優先探索
(define (depth person1 person2)
  (let loop ((queue (expand person1)))
    (and (pair? queue)
         (let ((head (car queue)))
           (or (eq? head person2)
               (loop (append (expand head) (cdr queue))))))))

;;; 展開関数
(define (expand person)
  (hash-ref person 'children))

;; ;; 実行例
;; > (depth Bill Frank)
;; #t