From 151ecb1b1ce2939403352d80799336e659e83e0d Mon Sep 17 00:00:00 2001
From: Dane Johnson <daneallenjohnson@protonmail.com>
Date: Fri, 25 Oct 2024 14:04:42 -0500
Subject: [PATCH] Add function to bi-directionally connect a graph

---
 graphgif.scm | 61 ++++++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 52 insertions(+), 9 deletions(-)

diff --git a/graphgif.scm b/graphgif.scm
index 4c64836..da2fbca 100644
--- a/graphgif.scm
+++ b/graphgif.scm
@@ -100,6 +100,42 @@
      (-1 . -1)
      (+1 . -1))))
 
+(define lset-unionq (partial lset-union eq?))
+
+(define (forward-connect node graph idx)
+  (cons idx
+	(set-node-edges
+	 node
+	 (lset-unionq
+	  (node-edges node)
+	  (fold (lambda (entry set)
+		  (if (memq idx (node-edges (cdr entry)))
+		      (cons idx set)
+		      set))
+		'()
+		graph)))))
+
+(define (back-connect edges graph idx)
+  (map
+   (lambda (entry)
+     (cons (car entry)
+	   (if (memq (car entry) edges)
+	       (set-node-edges
+		(cdr entry)
+		(lset-unionq (node-edges (cdr entry)) `(,idx)))
+	       (cdr entry))))
+   graph))
+
+(define-public (connect-bidirectionally graph)
+  (if (null? graph) '()
+      (let* ([idx (caar graph)]
+	     [node (cdar graph)])
+	(cons (forward-connect node (cdr graph) idx)
+	      (back-connect
+	       (node-edges node)
+	       (connect-bidirectionally (cdr graph))
+	       idx)))))
+
 (define-public (generate-web w h)
   (define (make-node i)
     (cons i
@@ -111,7 +147,7 @@
   (let loop ([i 0]
 	     [lst '()])
     (if (>= i (* w h))
-	(reverse lst)
+	(connect-bidirectionally (reverse lst))
 	(loop (1+ i) (cons (make-node i) lst)))))
 
 (define-public (remove-rect graph w x1 y1 x2 y2)
@@ -121,21 +157,27 @@
   (define edges-to-remove
     (unfold (lambda (s) (> s (xy->idx x2 y2 w)))
 	    identity
-	    (lambda (s) (if (>= (idx->x s w) x2)
-			    (xy->idx x1 (1+ (idx->y s w)) w)
-			    (1+ s)))
+	    (lambda (s)
+	      (if (>= (idx->x s w) x2)
+		  (xy->idx x1 (1+ (idx->y s w)) w)
+		  (1+ s)))
 	    (xy->idx x1 y1 w)))
   (filter-map
    (lambda (idx/node)
      (if (memq (car idx/node) edges-to-remove)
 	 #f
 	 (cons (car idx/node)
-	       (set-node-edges (cdr idx/node)
-			       (remove
-				(lambda (edge) (memq edge edges-to-remove))
-				(node-edges (cdr idx/node)))))))
+	       (set-node-edges
+		(cdr idx/node)
+		(remove
+		 (lambda (edge) (memq edge edges-to-remove))
+		 (node-edges (cdr idx/node)))))))
    graph))
 
+;;;;;;;;;;;;;;;;;;;
+;; ALGORITHMS!!! ;;
+;;;;;;;;;;;;;;;;;;;
+
 ;;;;;;;;;;;;
 ;; Output ;;
 ;;;;;;;;;;;;
@@ -153,7 +195,8 @@
 	   "-r" "1" "-loop" "0" filename))
 
 (define-public (write-graphs-to-file graphs filename)
-  (output-to-file (vector-map (lambda (_ graph) (draw-abstract-graph graph)) graphs) filename))
+  (output-to-file (vector-map (lambda (_ graph) (draw-abstract-graph graph)) graphs)
+		  filename))
 
 ;; Local Variables:
 ;; geiser-scheme-implementation: guile