File cleanup bc I'm anal

graphgif.scm

@@ -1,19 +1,17 @@
 (define-module (graphgif))
-
 (use-modules (cairo)
 	     (d-)
 	     (srfi srfi-1)
 	     (srfi srfi-9 gnu)
 	     (srfi srfi-11)
 	     (srfi srfi-43))
-
 (re-export (cairo-pattern-create-rgb . create-color))
 
 ;;;;;;;;;;;;;;;;;;;
 ;; Basic Drawing ;;
 ;;;;;;;;;;;;;;;;;;;
 
-(define-public pi 3.14159)
+(define-public pi 3.14159) ;; Good enough
 (define-public tau (* 2 pi))
 
 (define-public black (cairo-pattern-create-rgb 0 0 0))
@@ -31,11 +29,11 @@
 	node-color set-node-color)
 
 (define (edge-painter cr graph)
+  "Creates a closure that draws the edges of graph using cr"
   (lambda (node)
     (cairo-set-source cr black)
-    (let ([x (car (node-coords node))]
+    (let-values ([(x y) (car+cdr (node-coords node))]
-	  [y (cdr (node-coords node))]
+		 [edges (node-edges node)])
-	  [edges (node-edges node)])
       (for-each
        (lambda (edge)
 	 (let* ([other (assq-ref graph edge)]
@@ -47,10 +45,10 @@
        edges))))
 
 (define (node-painter cr)
+  "Creates a closure that draws the nodes of graph using cr"
   (lambda (node)
-    (let ([x (car (node-coords node))]
+    (let-values ([(x y) (car+cdr (node-coords node))]
-	  [y (cdr (node-coords node))]
+		 [color (or (node-color node) white)])
-	  [color (or (node-color node) white)])
       (cairo-arc cr x y 4. 0. tau)
       (cairo-set-source cr color)
       (cairo-fill-preserve cr)
@@ -58,6 +56,7 @@
       (cairo-stroke cr))))
 
 (define-public (draw-abstract-graph graph)
+  "Creates a cairo surface with graph drawn on it"
   (let* ([surface (cairo-image-surface-create 'rgb24 400 400)]
 	 [cr (cairo-create surface)])
     (define paint-edges (edge-painter cr graph))
@@ -76,15 +75,19 @@
 ;;;;;;;;;;;;;;;;;;;;;;
 
 (define (idx->x i w)
+  "Given i and width w, returns the x value"
   (modulo i w))
 
 (define (idx->y i w)
+  "Given i and width w, returns the y value"
   (quotient i w))
 
 (define (xy->idx x y w)
+  "Returns the index of x y on width x in a linear buffer"
   (+ (* y w) x))
 
 (define (idx->edges i w)
+  "Returns the edges needed to fully connect i on graph width w"
   (filter-map
    (lambda (offset)
      (let* ([x (idx->x i w)]
@@ -97,10 +100,13 @@
 	(< ox w)
 	(xy->idx ox oy w))))
    ;; Auto-connect these directions if legal indices
-   '(( 0 . -1)
+   ;; This combined with forwards and back connections create a
-     (-1 .  0)
+   ;; fully connected graph
-     (-1 . -1)
+   '(( 0 . -1) ;; Above
-     (+1 . -1))))
+     (-1 .  0) ;; Right
+     (-1 . -1) ;; Right-above
+     (+1 . -1) ;; Left above
+     )))
 
 (define lset-unionq (partial lset-union eq?))
 
@@ -129,6 +135,7 @@
    graph))
 
 (define-public (connect-bidirectionally graph)
+  "Takes a directed graph and connects all edges to make it fully bidirectional"
   (if (null? graph) '()
       (let* ([idx (caar graph)]
 	     [node (cdar graph)])
@@ -139,6 +146,7 @@
 	       idx)))))
 
 (define-public (generate-web w h)
+  "Creates a fully connected graph of width w and height h"
   (define (make-node i)
     (cons i
 	  (node
@@ -153,6 +161,7 @@
 	(loop (1+ i) (cons (make-node i) lst)))))
 
 (define-public (remove-rect graph w x1 y1 x2 y2)
+  "Removes a rectangular section of a fully connected rectangular graph"
   ;; Assumption is that is a graph generated by generate-web
   ;; and that it has not been re-indexed
   ;; x1 < x2, y1 < y2
@@ -180,7 +189,6 @@
 ;; ALGORITHMS!!! ;;
 ;;;;;;;;;;;;;;;;;;;
 
-;; Heap algorithms
 (define-public (heap-insert priority item heap)
   (define (fix-up! i heap)
     (if (zero? i)
@@ -217,10 +225,15 @@
 	(vector-set! new-heap 0 (vector-ref heap (1- (vector-length heap))))
 	(fix-down! new-heap 0))))
 
+(define (make-inf-queue graph)
+  "Creates a heap of the graph where all priorities are +inf"
+  (list->vector
+   (map (lambda (entry)
+	  (cons (inf) (car entry)))
+	graph)))
+
 (define* (djikstra graph source sink #:optional update)
-  (define unvisited (list->vector (map (lambda (entry)
+  (define unvisited (make-inf-queue graph))
-					 (cons (inf) (car entry)))
-				       graph)))
   (let iter ([heap (heap-insert 0 source unvisited)]
 	     [visited '()])
     (define-values (dist idx) (car+cdr (heap-peek heap)))
@@ -239,14 +252,11 @@
 (export djikstra)
 
 (define* (a* graph source sink #:optional update)
-  "Uses the Chebychev distance as a heuristic"
+  (define (chebychev idx) ;; Uses the Chebychev distance as a heuristic
-  (define (chebychev idx)
     (let-values ([(x1 y1) (car+cdr (node-coords (assv-ref graph idx)))]
 		 [(x2 y2) (car+cdr (node-coords (assv-ref graph sink)))])
       (max (abs (- x1 x2)) (abs (- y1 y2)))))
-  (define unvisited (list->vector (map (lambda (entry)
+  (define unvisited (make-inf-queue graph))
-					 (cons (inf) (car entry)))
-				       graph)))
   (let iter ([heap (heap-insert (chebychev source) source unvisited)]
 	     [visited '()])
     (define-values (dist idx) (car+cdr (heap-peek heap)))
@@ -269,6 +279,7 @@
 ;;;;;;;;;;;;
 
 (define (output-to-file filename surface-gen)
+  "Takes a filename and a coroutine to generate surfaces, and creates an animation"
   (define pngdir (mkdtemp "/tmp/graphgif_XXXXXX"))
   (let loop ([surface (surface-gen)]
 	     [i 1])
@@ -282,11 +293,8 @@
 	   "-loop" "0" filename))
 
 (define-public (write-graphs-to-file filename graph-gen)
+  "Takes a filename and a couroutine to generate graphs, and creates an animation"
   (define (surface-gen)
     (let ([graph (graph-gen)])
       (and graph (draw-abstract-graph graph))))
   (output-to-file filename surface-gen))
-
-;; Local Variables:
-;; geiser-scheme-implementation: guile
-;; End: