Tarjan: Difference between revisions

</pre>

=={{header|Racket}}==

{{trans|Kotlin}}

<lang racket>#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 low-link _))]))

(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 vs) (in-hash g)]

[w (in-list (cons u vs))]

#:when (not (node-index w))) (dfs w))

sccs)

(define (make-graph h)

(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 ([(u vs) (in-hash h)]) (values (make-node u) (map make-node vs))))

(tarjan (make-graph #hash([0 . (1)]

[2 . (0)]

[5 . (2 6)]

[6 . (5)]

[1 . (2)]

[3 . (1 2 4)]

[4 . (5 3)]

[7 . (4 7 6)])))</lang>

{{out}}

<pre>

'((7) (3 4) (5 6) (2 1 0))