Initial data commit

Task/Tarjan/Racket/tarjan-1.rkt

@@ -0,0 +1,62 @@
+#lang racket
+
+(require syntax/parse/define
+         fancy-app
+         (for-syntax racket/syntax))
+
+(struct node (name index low-link on?) #:transparent #:mutable
+  #:methods gen:custom-write
+  [(define (write-proc v port mode) (fprintf port "~a" (node-name v)))])
+
+(define-syntax-parser change!
+  [(_ x:id f) #'(set! x (f x))]
+  [(_ accessor:id v f)
+   #:with mutator! (format-id this-syntax "set-~a!" #'accessor)
+   #'(mutator! v (f (accessor v)))])
+
+(define (tarjan g)
+  (define sccs '())
+  (define index 0)
+  (define s '())
+
+  (define (dfs v)
+    (set-node-index! v index)
+    (set-node-low-link! v index)
+    (set-node-on?! v #t)
+    (change! s (cons v _))
+    (change! index add1)
+
+    (for ([w (in-list (hash-ref g v '()))])
+      (match-define (node _ index low-link on?) w)
+      (cond
+        [(not index) (dfs w)
+                     (change! node-low-link v (min (node-low-link w) _))]
+        [on? (change! node-low-link v (min index _))]))
+
+    (when (= (node-low-link v) (node-index v))
+      (define-values (scc* s*) (splitf-at s (λ (w) (not (eq? w v)))))
+      (set! s (rest s*))
+      (define scc (cons (first s*) scc*))
+      (for ([w (in-list scc)]) (set-node-on?! w #f))
+      (change! sccs (cons scc _))))
+
+  (for* ([(u _) (in-hash g)] #:when (not (node-index u))) (dfs u))
+  sccs)
+
+(define (make-graph xs)
+  (define store (make-hash))
+  (define (make-node v) (hash-ref! store v (thunk (node v #f #f #f))))
+
+  ;; it's important that we use hasheq instead of hash so that we compare
+  ;; reference instead of actual value. Had we use the actual value,
+  ;; the key would be a mutable value, which causes undefined behavior
+  (for/hasheq ([vs (in-list xs)]) (values (make-node (first vs)) (map make-node (rest vs)))))
+
+(tarjan (make-graph '([0 1]
+                      [2 0]
+                      [5 2 6]
+                      [6 5]
+                      [1 2]
+                      [3 1 2 4]
+                      [4 5 3]
+                      [7 4 7 6])))

Task/Tarjan/Racket/tarjan-2.rkt

@@ -0,0 +1,14 @@
+#lang racket
+
+(require graph)
+
+(define g (unweighted-graph/adj '([0 1]
+                                  [2 0]
+                                  [5 2 6]
+                                  [6 5]
+                                  [1 2]
+                                  [3 1 2 4]
+                                  [4 5 3]
+                                  [7 4 7 6])))
+
+(scc g)