Fix a bug in srfi-234 reference impl

ChangeLog

@@ -1,3 +1,8 @@
+2024-10-19  Shiro Kawai  <[email protected]>
+
+	* lib/srfi/234.scm (connected-components): Fix a bug in the
+	  reference impl.
+
 2024-10-10  Shiro Kawai  <[email protected]>
 
 	* lib/gauche/version-alist.scm (gauche): Allow excluding certain

lib/srfi/234.scm

@@ -105,10 +105,8 @@
 ;; Calculate the connected components from a graph of in-neighbors
 ;; implements Kosaraju's algorithm: https://en.wikipedia.org/wiki/Kosaraju%27s_algorithm
 (define (connected-components graph)
-  (define nodes-with-inbound-links (map car graph))
   ;; graph of out-neighbors
   (define graph/inverted (edgelist->graph (graph->edgelist/inverted graph)))
-  (define nodes-with-outbound-links (map car graph/inverted))
   ;; for simplicity this uses a list of nodes to query for membership. This is expensive.
   (define visited '())
   (define vertex-list '())
@@ -140,7 +138,9 @@
     (unless (member u in-component)
       (set! components (cons '() components))
       (assign! u u)))
-  (for-each visit! nodes-with-outbound-links)
+  ;; We visit all vertices.  The next expression may call visit! on
+  ;; the same node more than once, but second time and after is no-op.
+  (for-each (lambda (g) (for-each visit! g)) graph)
   (for-each assign-as-component! vertex-list)
   components)
 

test/include/srfi-234-test.scm

@@ -108,17 +108,35 @@
                                (6 5)
                                (7 4) (7 6) (7 7))))
 
-(test-equal
-    '((2 0 1) (6 5) (3 4) (7))
-  (connected-components
-   (edgelist->graph '((0 1)
-                      (1 2)
-                      (2 0)
-                      (3 1) (3 2) (3 4)
-                      (4 3) (4 5)
-                      (5 2) (5 6)
-                      (6 5)
-                      (7 4) (7 6) (7 7)))))
+(test-assert
+ (lset= (lambda (a b) (lset= eqv? a b))
+        '((1 2) (3 4))
+        (connected-components '((1 2 3 4)
+                                (2 1 3)
+                                (3 4)
+                                (4 3)))))
+
+(test-assert
+ (lset= (lambda (a b) (lset= eqv? a b))
+        '((1) (2) (3) (4))
+        (connected-components '((1 2 3 4)
+                                (2 3)
+                                (3 4)))))
+
+(test-assert
+ (lset= (lambda (a b) (lset= eqv? a b))
+        '((2 0 1) (6 5) (3 4) (7))
+        (connected-components
+         (edgelist->graph '((0 1)
+                            (1 2)
+                            (2 0)
+                            (3 1) (3 2) (3 4)
+                            (4 3) (4 5)
+                            (5 2) (5 6)
+                            (6 5)
+                            (7 4) (7 6) (7 7))))))
+
+
 
 (define (permutations edgelist)
   (if (null? edgelist) '(())