#lang typed/racket/base
(provide (all-defined-out))
(define-struct: forest
([ht : (HashTable Symbol node)]))
(define-struct: node
([elt : Symbol]
[p : (U False node)]
[rank : Natural])
#:mutable)
(: new-forest (-> forest))
(define (new-forest)
(make-forest (make-hash)))
(: lookup-node (forest Symbol -> node))
(define (lookup-node a-forest an-elt)
(unless (hash-has-key? (forest-ht a-forest) an-elt)
(make-set a-forest an-elt))
(hash-ref (forest-ht a-forest)
an-elt))
(: make-set (forest Symbol -> Void))
(define (make-set a-forest an-elt)
(unless (hash-has-key? (forest-ht a-forest) an-elt)
(let ([a-node (make-node an-elt #f 0)])
(set-node-p! a-node a-node)
(hash-set! (forest-ht a-forest) an-elt a-node))))
(: find-set (forest Symbol -> Symbol))
(define (find-set a-forest an-elt)
(let ([a-node (lookup-node a-forest an-elt)])
(node-elt (get-representative-node a-node))))
(: get-representative-node (node -> node))
(define (get-representative-node a-node)
(let ([p (node-p a-node)])
(cond [(eq? a-node p)
a-node]
[(node? p)
(let ([rep (get-representative-node p)])
(set-node-p! a-node rep)
rep)]
[else
(error 'get-representative-node)])))
(: union-set (forest Symbol Symbol -> Void))
(define (union-set a-forest elt1 elt2)
(let ([rep1 (get-representative-node
(lookup-node a-forest elt1))]
[rep2 (get-representative-node
(lookup-node a-forest elt2))])
(cond
[(< (node-rank rep1) (node-rank rep2))
(set-node-p! rep1 rep2)]
[(> (node-rank rep1) (node-rank rep2))
(set-node-p! rep2 rep1)]
[else
(set-node-p! rep1 rep2)
(set-node-rank! rep1 (add1 (node-rank rep1)))])))