examples/examples.rkt
```#lang racket
(require (planet "main.rkt" ("samsergey" "rewrite.plt" 1 0))
rackunit)
;;;====================================================
;;; Simple examples
;;;====================================================

;; singlefold rewriting
(check-equal?  ((/. 'a --> 'b
'b --> 'c
'c --> 'd) '(a b c d))
'(b c d d))

(check-equal?  ((/. 'a --> 'b
'b --> 'c
'c --> 'a) '(a b c d))
'(b c a d))

;; using multiary rules
(check-equal?  ((/. 'a --> 'b
'b 1 --> 'c
'c 1 2 --> 'a) 'a)
'b)

(check-equal?  ((/. 'a --> 'b
'b 1 --> 'c
'c 1 2 --> 'a) 'b 1)
'c)

(check-equal?  ((/. 'a --> 'b
'b 1 --> 'c
'c 1 2 --> 'a) 'x 'y 'z 't)
'(x y z t))

;; repetitive rewriting
(check-equal?  ((//. 'a --> 'b
'b --> 'c
'c --> 'd) '(a b c d))
'(d d d d))

(check-equal?  ((//. 'a -->. 'b ; terminal rule
'b --> 'a
'c --> 'a) '(a b c d))
'(b b b d))

;;====================================================
;; Definition of recursive funtions
;;====================================================

(define/. length
; length of the list
(cons _ t) --> (+ 1 (length t))
'() --> 0)

(define/. depth
; depth of the nested list structure
(? list? x) --> (+ 1 (apply max (map depth x)))
_ --> 0)

(define fib
; n -th Fibonacci number
(replace
1 --> 0
2 --> 1
n --> (fib 0 1 n)
a b 3 --> (+ a b)
a b i --> (fib b (+ a b) (- i 1))))

(define/. palindrom?
; palindrom test
(or '() (list _)) --> #t
(list x y ___ x)  --> (palindrom? y))

(check-true   (palindrom? '()))
(check-true   (palindrom? '(a a)))
(check-true   (palindrom? '(a b a)))
(check-equal? (palindrom? '(r e v o l v e r)) '(o l))

;;====================================================
;; Symbolic expansion for the logarythmic function
;;====================================================
(define ln-expand
(replace-all-repeated
`(ln (,x __1 * ,y __1)) --> `((ln ,x) + (ln ,y))
`(ln (,x __1 / ,y __1)) --> `((ln ,x) - (ln ,y))
`(ln (,x ^ ,n))         --> `(,n * (ln ,x))
`(ln (,x))              --> `(ln ,x)))

(check-equal? (ln-expand '(ln(x * y)))           '((ln x) + (ln y)))
(check-equal? (ln-expand '(ln(x / y)))           '((ln x) - (ln y)))
(check-equal? (ln-expand '(ln(x * y / z)))       '((ln x) + ((ln y) - (ln z))))
(check-equal? (ln-expand '(ln(x / (y * z))))     '((ln x) - ((ln y) + (ln z))))
(check-equal? (ln-expand '(ln(x ^ 2 / (y * z)))) '((2 * (ln x)) - ((ln y) + (ln z))))
(check-equal? (ln-expand '(ln(x + y)))           '(ln (x + y)))
(check-equal? (ln-expand '(ln(8 * (x + y))))     '((ln 8) + (ln (x + y))))
(check-equal? (ln-expand '(ln(ln(x ^ n))))       '((ln n) + (ln(ln x))))

;;====================================================
;; Hoare's quicksort
;;====================================================

(define (split x l)
(foldl (/. y `(,l ,r) --> (? (< y x)) `(,(cons y l) ,r)
y `(,l ,r) -->             `(,l ,(cons y r)))
'(() ()) l))

(define qsort
(replace-repeated
(cons x y) --> (values x (split x y))
x `(,l ,r) -->. (append (qsort l) `(,x) (qsort r))))

(check-equal? (qsort '()) '())
(check-equal? (qsort '(1 1)) '(1 1))
(check-equal? (qsort '(2 4 1 3 2 6 9 2)) '(1 2 2 2 3 4 6 9))

;;====================================================
;; The bisection method for solving algebraic equations
;;====================================================
(define (bisection f)
(replace-repeated
; start iterations
a b --> (values a b (f a) (f b))
; no roots
_ _ fa fb -->. (? (> (* fa fb) 0)) #f
; stop iterations when needed accuracy is achieved
a b _ _   -->. (? (almost-equal? a b)) a
; general case
a b fa fb -->. (let* ([c (/ (+ a b) 2.)]
[fc (f c)])
(or ((bisection f) a c fa fc)
((bisection f) c b fc fb)))))

(check almost-equal? ((bisection (λ(x)(- x 2))) 1 3) 2)
(check almost-equal? ((bisection (λ(x)(- (sin x) .4))) 0 2) (asin 0.4))```