From 38024f75e5a7b74fde618ef8f00a8f3ac71a9f05 Mon Sep 17 00:00:00 2001
From: Jacob Matthews <jacobm@cs.uchicago.edu>
Date: Sun, 6 Feb 2005 06:25:03 +0000
Subject: [PATCH] Added find-shortest-path method to the graph-snip mixin.

original commit: 21dddedfccfed2755488da0537eda138a0c7c144
---
 collects/mrlib/graph.ss | 27 ++++++++++++++++++++++++++-
 1 file changed, 26 insertions(+), 1 deletion(-)

diff --git a/collects/mrlib/graph.ss b/collects/mrlib/graph.ss
index 8f49c774..4cdd0230 100644
--- a/collects/mrlib/graph.ss
+++ b/collects/mrlib/graph.ss
@@ -20,7 +20,9 @@
       get-parents
       get-parent-links
       add-parent
-      remove-parent))
+      remove-parent
+      
+      find-shortest-path))
   
   (provide/contract (add-links
 		     (case->
@@ -122,6 +124,29 @@
                  parent-links
                  (lambda (parent parent-link) (eq? (link-snip parent-link) parent))))))
       
+      (define/public (find-shortest-path other)
+        (define visited-ht (make-hash-table))
+        (define (first-view? n) 
+          (hash-table-get visited-ht n (lambda () 
+                                         (hash-table-put! visited-ht n #f)
+                                         #t)))
+        (let loop ((horizon (list (list this))))
+          (cond
+            [(null? horizon) #f]
+            [(assq other horizon) => (lambda (winner) winner)]
+            [else
+             (let inner-loop ((paths horizon)
+                              (acc '()))
+               (cond
+                 [(null? paths) (loop (apply append acc))]
+                 [else
+                  (let ((path (car paths)))
+                    (inner-loop 
+                     (cdr paths)
+                     (cons 
+                      (map (lambda (child) (cons child path)) (filter first-view? (send (car path) get-children)))
+                      acc)))]))])))
+      
       (super-instantiate ())
       
       (inherit set-snipclass)