The (aux fds) modules
Functional queues and union-find
(aux fds queue): functional queues#
test-letqueue: pass
(define (test-letqueue _)
(⊦= 2 (cadr '(1 2)))
(letqueue
((q '()) (w '(a)) (e '(a b)) (r '(a b c)) (t '(a b c d)))
(⊦= '(0 ()) q)
(⊨ (fds-queue-empty? q))
(⊦= '(1 (a)) w)
(⊭ (fds-queue-empty? w))
(⊦= '(2 (a) b) e)
(⊭ (fds-queue-empty? e))
(⊦= '(3 (a) c b) r)
(⊭ (fds-queue-empty? r))
(⊦= '(4 (a) d c b) t)
(⊭ (fds-queue-empty? t))))
((eta 0.0) (memory #(6291456 1890928 1048576)) (stdout "") (stderr ""))
test-cons-cdr: pass
(define (test-cons-cdr _)
(letqueue
((q '()))
(⊦= '(0 ()) q)
(set! q (fds-queue-cons 'a q))
(⊦= '(1 (a)) q)
(⊭ (fds-queue-empty? q))
(⊦= 'a (fds-queue-car q))
(set! q (fds-queue-cons 'b q))
(⊦= '(2 (a) b) q)
(⊭ (fds-queue-empty? q))
(⊦= 'a (fds-queue-car q))
(set! q (fds-queue-cons 'c q))
(⊦= '(3 (a) c b) q)
(⊭ (fds-queue-empty? q))
(⊦= 'a (fds-queue-car q))
(set! q (fds-queue-cdr q))
(⊦= '(2 (b c)) q)
(⊭ (fds-queue-empty? q))
(⊦= 'b (fds-queue-car q))
(set! q (fds-queue-cdr q))
(⊦= '(1 (c)) q)
(⊭ (fds-queue-empty? q))
(⊦= 'c (fds-queue-car q))
(set! q (fds-queue-cdr q))
(⊦= '(0 ()) q)
(⊨ (fds-queue-empty? q))))
((eta 0.0) (memory #(6291456 1891656 1048576)) (stdout "") (stderr ""))
test-empty-car: pass
(define (test-empty-car _)
(letqueue
((q '()))
(⊦= "fds-queue-car: empty queue" (error-message (λ () (fds-queue-car q))))
(⊦= "fds-queue-cdr: empty queue" (error-message (λ () (fds-queue-cdr q))))
(⊦= "fds-queue-car: empty queue"
(error-message
(λ () (fds-queue-car (fds-queue-cdr (fds-queue-cons 'a q))))))))
((eta 0.0) (memory #(6291456 1901280 1048576)) (stdout "") (stderr ""))
(aux fds unionfind): union-find#
test-find-and-union: pass
(define (test-find-and-union _)
(unionfind-new
(λ (U ↑ ↑! ≡ →)
(⊦= 'absent (↑ 'absent))
(⊦= '(a b) (↑ '(a b)))
(⊦= 0 (length (→)))
(≡ 3 4)
(⊦= 4 (↑ 3))
(⊦= 4 (↑ 4))
(let1 (edges (→))
(⊦= '(3 . 4) (assoc 3 edges))
(⊦= '(4 . 4) (assoc 4 edges)))
(let1 (s (with-output-to-string (λ () (display U))))
(⊨ (and (substring-index "(4 -> 4)\n" s) #t))
(⊨ (and (substring-index "(3 -> 4)\n" s) #t))
(⊦= (string-length "(4 -> 4)\n(3 -> 4)\n") (string-length s))))))
((eta 0.0) (memory #(6291456 2019520 1048576)) (stdout "") (stderr ""))
test-union-by-rank: pass
(define (test-union-by-rank _)
(unionfind-new
(λ (U ↑ ↑! ≡ →)
(⊦= 0 (length (→)))
(≡ 'A 'D)
(≡ 'B 'E)
(≡ 'C 'F)
(let1 (edges (unionfind->→+★ U))
(⊨ (member? '((A . 0) (D . 1)) edges))
(⊨ (member? '((B . 0) (E . 1)) edges))
(⊨ (member? '((C . 0) (F . 1)) edges))
(⊨ (member? '((D . 1) (D . 1)) edges))
(⊨ (member? '((E . 1) (E . 1)) edges))
(⊨ (member? '((F . 1) (F . 1)) edges)))
(≡ 'C 'G)
(≡ 'E 'A)
(let1 (edges (unionfind->→+★ U))
(⊨ (member? '((A . 0) (D . 2)) edges))
(⊨ (member? '((E . 1) (D . 2)) edges))
(⊨ (member? '((B . 0) (E . 1)) edges))
(⊨ (member? '((C . 0) (F . 1)) edges))
(⊨ (member? '((G . 0) (F . 1)) edges))
(⊨ (member? '((D . 2) (D . 2)) edges))
(⊨ (member? '((F . 1) (F . 1)) edges)))
(≡ 'B 'G)
(let1 (edges (unionfind->→+★ U))
(⊨ (member? '((A . 0) (D . 2)) edges))
(⊨ (member? '((E . 1) (D . 2)) edges))
(⊨ (member? '((B . 0) (E . 1)) edges))
(⊨ (member? '((C . 0) (F . 1)) edges))
(⊨ (member? '((G . 0) (F . 1)) edges))
(⊨ (member? '((D . 2) (D . 2)) edges))
(⊨ (member? '((F . 1) (D . 2)) edges))))))
((eta 0.0) (memory #(6291456 2027864 1048576)) (stdout "") (stderr ""))
test-path-compression: pass
(define (test-path-compression _)
(unionfind-new
(λ (U ↑ ↑! ≡ →)
(≡ 'B 'A)
(≡ 'D 'C)
(≡ 'C 'A)
(≡ 'I 'F)
(≡ 'J 'F)
(≡ 'K 'G)
(≡ 'H 'E)
(≡ 'F 'E)
(≡ 'G 'E)
(≡ 'E 'A)
(let1 (edges (unionfind->→+★ U))
(⊨ (member? '((B . 0) (A . 3)) edges))
(⊨ (member? '((C . 1) (A . 3)) edges))
(⊨ (member? '((D . 0) (C . 1)) edges))
(⊨ (member? '((E . 2) (A . 3)) edges))
(⊨ (member? '((F . 1) (E . 2)) edges))
(⊨ (member? '((G . 1) (E . 2)) edges))
(⊨ (member? '((I . 0) (F . 1)) edges))
(⊨ (member? '((J . 0) (F . 1)) edges))
(⊨ (member? '((K . 0) (G . 1)) edges))
(⊨ (member? '((H . 0) (E . 2)) edges)))
(⊦= 'A (↑! 'I))
(let1 (edges (unionfind->→+★ U))
(⊨ (member? '((B . 0) (A . 3)) edges))
(⊨ (member? '((C . 1) (A . 3)) edges))
(⊨ (member? '((D . 0) (C . 1)) edges))
(⊨ (member? '((E . 2) (A . 3)) edges))
(⊨ (member? '((F . 1) (A . 3)) edges))
(⊨ (member? '((G . 1) (E . 2)) edges))
(⊨ (member? '((I . 0) (A . 3)) edges))
(⊨ (member? '((J . 0) (F . 1)) edges))
(⊨ (member? '((K . 0) (G . 1)) edges))
(⊨ (member? '((H . 0) (E . 2)) edges)))
(⊦= 'A (↑! 'K))
(let1 (edges (unionfind->→+★ U))
(⊨ (member? '((B . 0) (A . 3)) edges))
(⊨ (member? '((C . 1) (A . 3)) edges))
(⊨ (member? '((D . 0) (C . 1)) edges))
(⊨ (member? '((E . 2) (A . 3)) edges))
(⊨ (member? '((F . 1) (A . 3)) edges))
(⊨ (member? '((G . 1) (A . 3)) edges))
(⊨ (member? '((I . 0) (A . 3)) edges))
(⊨ (member? '((J . 0) (F . 1)) edges))
(⊨ (member? '((K . 0) (A . 3)) edges))
(⊨ (member? '((H . 0) (E . 2)) edges))))))
((eta 0.0) (memory #(6291456 2024280 1048576)) (stdout "") (stderr ""))
test-edges-size-copy: pass
(define (test-edges-size-copy _)
(let* ((U (unionfind-empty)) (≡ (unionfind-≡ U)))
(⊨ (unionfind? U))
(⊦= 0 (unionfind-size U))
(⊦= 0 (unionfind-edges U))
(≡ 1 2)
(≡ 3 4)
(⊦= 4 (unionfind-size U))
(⊦= 2 (unionfind-edges U))
(⊦= '(1 2 3 4) (sort (unionfind-keys U) <))
(let* ((W (unionfind-copy U)) (≡W (unionfind-≡ W)))
(≡W 2 4)
(≡W 5 6)
(⊦= 6 (unionfind-size W))
(⊦= 4 (unionfind-edges W))
(⊦= ((unionfind-↑ W) 1) ((unionfind-↑ W) 3))
(⊦= 4 (unionfind-size U))
(⊦= 2 (unionfind-edges U))
(⊦= 2 ((unionfind-↑ U) 1))
(⊦= 4 ((unionfind-↑ U) 3))
(⊦= 1 ((unionfind-★ U) 2)))))
((eta 0.0) (memory #(6291456 2036352 1048576)) (stdout "") (stderr ""))
test-walk-and-accessors: pass
(define (test-walk-and-accessors _)
(let1 (U (unionfind-empty))
(unionfind-accessors
U
(λ (↑ ↑! ≡ →)
(≡ 'x 'y)
(≡ 'y 'z)
(⊦= (↑ 'x) (↑ 'z))
(⊦= 3 (length (→)))))
(⊦= 3 (unionfind-walk U (λ (k v) (void)) (λ () (unionfind-size U))))
(let1 (links '())
(unionfind-walk/without-loops
U
(λ (k v) (set! links (cons k links)))
(λ () (⊦= 2 (length links))))
(⊭ (member? ((unionfind-↑ U) 'x) links)))))
((eta 0.0) (memory #(6291456 2023152 1048576)) (stdout "") (stderr ""))
test-rank-absent: pass
(define (test-rank-absent _)
(let1 (U (unionfind-empty))
(⊨ (condition-case (begin ((unionfind-★ U) 'nope) #f) ((exn) #t)))
(⊦= 'nope ((unionfind-↑ U) 'nope))
(⊦= 'nope ((unionfind-↑! U) 'nope))
(⊦= '() (unionfind->→+★ U))))
((eta 0.0) (memory #(6291456 2033624 1048576)) (stdout "") (stderr ""))