#lang racket
(require (planet "main.rkt" ("samsergey" "rewrite.plt" 1 0))
rackunit)
(define (DFA start program)
(λ(input)
(foldl program start input)))
(define even/odd
(DFA 'even
(/. 0 'even --> 'even
1 'even --> 'odd
0 'odd --> 'even
1 'odd --> 'odd)))
(check-eq? (even/odd '(1 0 1)) 'odd)
(check-eq? (even/odd '(1 1 0)) 'even)
(define div/3
(compose
(/. 's0 --> 0 's1 --> 1 's2 --> 2)
(DFA 's0
(/. 0 's0 --> 's0
1 's0 --> 's1
0 's1 --> 's2
1 's1 --> 's0
0 's2 --> 's1
1 's2 --> 's2))))
(check-eq? (div/3 '(0 1 1)) 0)
(check-eq? (div/3 '(1 0 0)) 1)
(check-eq? (div/3 '(1 0 1)) 2)
(define (TFA start program)
(λ(input)
(foldr (/. el (cons S res) --> (append (program el S) res))
(list start)
input)))
(define add1
(TFA 1
(/. 0 0 --> '(0 0)
0 1 --> '(0 1)
1 0 --> '(0 1)
1 1 --> '(1 0))))
(check-equal? (add1 '(0 0 0)) '(0 0 0 1))
(check-equal? (add1 '(0 0 1)) '(0 0 1 0))
(check-equal? (add1 '(0 1 0)) '(0 0 1 1))
(check-equal? (add1 '(1 1 1)) '(1 0 0 0))
(check-equal? (add1 '()) '(1))
(define complement
(compose
cdr
(TFA 'A
(/. 0 'A --> '(A 0)
1 'A --> '(B 1)
0 'B --> '(B 1)
1 'B --> '(B 0)))))
(check-equal? (complement '(0 0 0)) '(0 0 0))
(check-equal? (complement '(0 0 1)) '(1 1 1))
(check-equal? (complement '(0 1 0)) '(1 1 0))
(check-equal? (complement '(0 1 1)) '(1 0 1))
(check-equal? (complement '(1 1 1)) '(0 0 1))
(define edge
(compose
cdr
(TFA 'start
(/. 0 'start --> '(s0 0)
1 'start --> '(s1 0)
0 's0 --> '(s0 0)
1 's0 --> '(s1 1)
0 's1 --> '(s0 1)
1 's1 --> '(s1 0)))))
(check-equal? (edge '(0 0 0)) '(0 0 0))
(check-equal? (edge '(0 0 1 1 1 0)) '(0 1 0 0 1 0))
(check-equal? (edge '(1 1 0 0 0 1 1 0)) '(0 1 0 0 1 0 1 0))
(define NMA
(//.
`(,a ___ * 0 ,b ___) --> `(,@a 0 * * ,@b)
`(,a ___ 1 ,b ___) --> `(,@a 0 * ,@b)
`(,a ___ 0 ,b ___) --> `(,@a ,@b)))
(check-equal? (NMA '(0)) '())
(check-equal? (NMA '(1)) '(*))
(check-equal? (NMA '(1 0)) '(* *))
(check-equal? (NMA '(1 1)) '(* * *))
(check-equal? (NMA '(0 1 1 1)) '(* * * * * * *))