#lang racket/base
(require racket/match)
(require racket/vector)

(define (factorial n)
  (if (= n 0)
      1
      (* n (factorial ; recur
            (- n 1)))))
(println (factorial 5))
; 120

(define-syntax-rule (lambda/rec name arguments body ...)
  (letrec ((name (lambda arguments body ...)))
    name))

(println ((lambda/rec factorial~ (n)
                      (if (= n 0)
                          1
                          (* n (factorial~ ; recur, using the captured name
                                (- n 1)))))
          5))
; 120

(define util.counter (make-parameter (void)))
(define (util.increment!)
  (util.counter (+ 1 (util.counter))))
(define-syntax-rule (util.profile x)
  (parameterize ((util.counter 0))
    (let ((result x))
      (printf "ran: ~a\ncost: ~a\nresult: ~v\n"
              (quote x)
              (util.counter)
              result))))

(define-syntax-rule (util.repeat n x)
  (for ((_ (in-range n)))
    x))

(util.profile (util.repeat 99 (util.increment!)))
; cost: 99

(define (id x)
  (util.increment!)
  x)
(util.profile (util.repeat 99 (id 0)))
; cost: 99

(define (memoize f)
  (let ((cache (make-hash))) ; "let...
    (lambda (x) ; ...over lambda": a closure
      (hash-ref cache
                x
                (lambda () ; what to do if `x` was not already in `cache`
                  (let ((y (f x)))
                    (hash-set! cache x y)
                    y))))))

(define id/memo (memoize id))
(util.profile (util.repeat 99 (id/memo 0))) ; success!
; cost: 1

(define (fib n)
  (util.increment!)
  (cond
    ((< n 2)
     n)
    (else
     (+ (fib (- n 1))
        (fib (- n 2))))))
(util.profile (fib 7))
; cost: 41
; result: 13
(util.profile ((memoize fib) 7)) ; failure!
; cost: 41
; result: 13

(util.profile (let ((f (memoize fib)))
                (util.repeat 99 (f 7))))
; cost: 41

(define fib~
  (memoize (lambda (n)
             (util.increment!)
             (cond
               ((< n 2)
                n)
               (else
                (+ (fib~ (- n 1))
                   (fib~ (- n 2))))))))
(util.profile (fib~ 7)) ; redemption!
; cost: 8
; result: 13

(define-syntax-rule (define/memoized (f x) body ...)
  (define f (memoize (lambda (x) body ...))))

(define/memoized (fib/memo n) ; this looks like `fib`, but acts like `fib~`
  (util.increment!)
  (cond
    ((< n 2)
     n)
    (else
     (+ (fib/memo (- n 1))
        (fib/memo (- n 2))))))
(util.profile (fib/memo 7))
; cost: 8
; result: 13

(define (double t)
  (match t
    ((? number?) ; a number
     (* 2 t))
    ((list) ; an empty list
     t)
    ((cons u v) ; a non-empty list
     (cons (double u) (double v)))))

(define one--two-three (list 1 (list 2 3)))
(println one--two-three)
; '(1 (2 3))

(println (double one--two-three))
; '(2 (4 6))

(define (double/norec t)
  (match t
    ((? number?)
     (* 2 t))
    (_ t)))

(define (recursively f/norec)
  (lambda/rec f (t)
              (f/norec (match t
                         ((cons u v)
                          (cons (f u) (f v)))
                         (_ t)))))

(println ((recursively double/norec) one--two-three))
; '(2 (4 6))

(define (reverse-lists/norec t)
  (match t
    ((cons u v)
     (append ; "snoc" --- it's inefficient, but that's not the point here
      v (list u)))
    (_ t)))
(println ((recursively reverse-lists/norec) one--two-three))
; '((3 2) 1)

(define double-reverse
  (recursively (compose reverse-lists/norec
                        double/norec)))
(println (double-reverse one--two-three))
; '((6 4) 2)

(define (recursively/generic step f/norec)
  (lambda/rec f (x)
              (f/norec (step f x))))

(define (lists.step f x)
  (match x ; compare this to the `match` in `recursively`
    ((cons y z)
     (cons (f y) (f z)))
    (_ x)))
(define (lists->vectors/norec x)
  (match x
    ((list)
     (vector))
    ((cons y z)
     (vector-append (vector y) z))
    (_ x)))
(define lists->vectors (recursively/generic lists.step lists->vectors/norec))

(define (vectors.step f x)
  (if (vector? x)
      (vector-map f x)
      x))
(define vectors.double (recursively/generic vectors.step double/norec))

(println (vectors.double (lists->vectors one--two-three)))
; '#(2 #(4 6))

(struct :boolean () #:transparent) ; a poor man's algebraic data type
(struct :var :boolean (name) #:transparent)
(struct :not :boolean (arg) #:transparent)
(struct :or :boolean (arg1 arg2) #:transparent)
(struct :and :boolean (arg1 arg2) #:transparent)

(define v (:var "v"))
(define tautology (:or v (:not v)))

(define (:boolean.step f x)
  (match x
    ((:var _)
     x)
    ((:not y)
     (:not (f y)))
    ((:or y z)
     (:or (f y) (f z)))
    ((:and y z)
     (:and (f y) (f z)))))

(define (nnf/norec x)
  (match x
    ((:not (:not y))
     y)
    ((:not (:or y z))
     (:and (:not y) (:not z)))
    ((:not (:and y z))
     (:or (:not y) (:not z)))
    (_ x)))
(println ((recursively/generic :boolean.step nnf/norec) (:not tautology))) ; no!
; (:and (:not (:var "v")) (:not (:not (:var "v"))))

(define (top-down step f/norec)
  (lambda/rec f (x)
              (step f (f/norec x))))
(define nnf (top-down :boolean.step nnf/norec))
(println (nnf (:not tautology))) ; yes!
; (:and (:not (:var "v")) (:var "v"))

(define bottom-up recursively/generic)

(define (size/norec x)
  (match x
    ((:var _)
     1)
    ((:not y)
     (+ 1 y))
    ((or (:or y z)
         (:and y z))
     (+ 1 y z))))
(define size (bottom-up :boolean.step size/norec))
(let ((contradiction (:not tautology)))
  (println (size contradiction))
  (println (size (nnf contradiction))))
; 5
; 4

(define (:boolean.step! f x)
  (util.increment!)
  (:boolean.step f x))

(define size/nomemo (bottom-up :boolean.step! size/norec))
(util.profile (size/nomemo (:or tautology (:not tautology))))
; cost: 10
; result: 10

(define-syntax-rule (lambda/memoized f (x) body ...)
  (letrec ((f (memoize (lambda (x) body ...))))
    f))
(define (bottom-up/memoized step f/norec)
  (lambda/memoized f (x)
                   (f/norec (step f x))))
(define size/memo (bottom-up/memoized :boolean.step! size/norec))
(util.profile (size/memo (:or tautology (:not tautology))))
; cost: 5
; result: 10

(define (bottom-up/memoized/expanded step f/norec)
  (letrec ((f (memoize (lambda (x)
                         (f/norec (step f x))))))
    f))
(util.profile ((bottom-up/memoized/expanded :boolean.step! size/norec)
               (:or tautology (:not tautology))))
; cost: 5
; result: 10