Remove a section of the web

demo.scm

@@ -5,6 +5,6 @@
 (define red (create-color 1 0 0))
 
 (define graph1 (generate-web 10 10))
-(define graph2 (copy-tree graph1))
+(define graph2 (remove-rect (copy-tree graph1) 10 3 3 4 5))
 (assq-set! graph2 0 (set-node-color (assq-ref graph2 0) red))
 (write-graphs-to-file (list graph1 graph2) "graph.gif")

graphgif.scm

@@ -113,6 +113,28 @@
 	(reverse lst)
 	(loop (1+ i) (cons (make-node i) lst)))))
 
+(define-public (remove-rect graph w x1 y1 x2 y2)
+  ;; Assumption is that is a graph generated by generate-web
+  ;; and that it has not been re-indexed
+  ;; x1 < x2, y1 < y2
+  (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)))
+	    (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)))))))
+   graph))
+
 ;;;;;;;;;;;;
 ;; Output ;;
 ;;;;;;;;;;;;