Sucessfully implemented Djikstra's algorithm

graphgif.scm

@@ -111,7 +111,7 @@
 	  (node-edges node)
 	  (fold (lambda (entry set)
 		  (if (memq idx (node-edges (cdr entry)))
-		      (cons idx set)
+		      (cons (car entry) set)
 		      set))
 		'()
 		graph)))))
@@ -180,11 +180,11 @@
 ;;;;;;;;;;;;;;;;;;;
 
 ;; Heap algorithms
-(define (heap-insert priority item heap)
+(define-public (heap-insert priority item heap)
   (define (fix-up! i heap)
     (if (zero? i)
 	heap
-	(let* ([parent (quotient i 2)]
+	(let* ([parent (quotient (1- i) 2)]
 	       [i-priority (car (vector-ref heap i))]
 	       [parent-priority (car (vector-ref heap parent))])
 	  (when (<= i-priority parent-priority)
@@ -192,13 +192,13 @@
 	  (fix-up! parent heap))))
   (fix-up! (vector-length heap) (vector-append heap (vector (cons priority item)))))
 
-(define (heap-peek heap)
+(define-public (heap-peek heap)
   (if (vector-empty? heap) #f (vector-ref heap 0)))
 
-(define (heap-pop heap)
+(define-public (heap-pop heap)
   (define (fix-down! heap i)
     (let* ([len (vector-length heap)]
-	   [left (* 2 i)]
+	   [left (1+ (* 2 i))]
 	   [right (1+ left)])
       (if (< left len)
 	  (let ([min (if (< right len)
@@ -208,14 +208,35 @@
 		heap
 		(begin
 		  (vector-swap! heap i min)
-		  (fix-down! heap i))))
+		  (fix-down! heap min))))
 	  heap)))
-  (if (vector-empty? heap)
-      heap
+  (if (or (vector-empty? heap) (= (vector-length heap) 1))
+      #()
       (let ([new-heap (vector-copy heap 0 (1- (vector-length heap)))])
 	(vector-set! new-heap 0 (vector-ref heap (1- (vector-length heap))))
 	(fix-down! new-heap 0))))
 
+(define* (djikstra graph source sink #:optional update)
+  (define unvisited (list->vector (map (lambda (entry)
+					 (cons (inf) (car entry)))
+				       graph)))
+  (let iter ([heap (heap-insert 0 source unvisited)]
+	     [visited '()])
+    (define-values (dist idx) (car+cdr (heap-peek heap)))
+    (cond
+     [(eqv? sink idx) dist]
+     [(memv idx visited) (iter (heap-pop heap) visited)]
+     [(inf? dist) #f]
+     [else
+      (when update (update visited heap))
+      (iter (fold
+	     (lambda (edge heap)
+	       (heap-insert (+ dist 1) edge heap))
+	     (heap-pop heap)
+	     (node-edges (assv-ref graph idx)))
+	    (cons idx visited))])))
+(export djikstra)
+
 ;;;;;;;;;;;;
 ;; Output ;;
 ;;;;;;;;;;;;
@@ -230,7 +251,7 @@
    surfaces)
   (system* "ffmpeg" "-y"
 	   "-i" (string-append pngdir "/img-%d.png")
-	   "-r" "1" "-loop" "0" filename))
+	   "-loop" "0" filename))
 
 (define-public (write-graphs-to-file graphs filename)
   (output-to-file (vector-map (lambda (_ graph) (draw-abstract-graph graph)) graphs)