The (aux tabling) module

Memoization and tabled definitions

test/naive-fibonacci: pass

(define (test/naive-fibonacci _)
  (define F (λ (i) (cond ((< i 2) i) (else (+ (F (- i 1)) (F (- i 2)))))))
  (⊦= 0 (F 0))
  (⊦= 1 (F 1))
  (⊦= '(0 1 1 2 3 5 8 13 21) (map F (iota 9)))
  (time (⊦= 1346269 (F 31))))
((eta 0.801)
 (memory #(12582912 2224888 1048576))
 (stdout "")
 (stderr
   "0.794s CPU time, 0.004s GC time (major), 188258/31374 mutations (total/tracked), 2/13048 GCs (major/minor), maximum live heap: 2.12 MiB\n"))

test/define-tabled-fibonacci: pass

(define (test/define-tabled-fibonacci _)
  (define-tabled
    F₀
    (lambda (i)
      (cond ((zero? i) 0) ((one? i) 1) (else (+ (F₀ (- i 1)) (F₀ (- i 2)))))))
  (⊦= 0 (F₀ 0))
  (⊦= 1 (F₀ 1))
  (⊦= '(0 1 1 2 3 5 8 13 21) (map F₀ (iota 9)))
  (time (⊦= 1346269 (F₀ 31))))
((eta 0.004)
 (memory #(12582912 2236400 1048576))
 (stdout "")
 (stderr
   "0s CPU time, 1578/28 mutations (total/tracked), 0/2 GCs (major/minor), maximum live heap: 2.13 MiB\n"))

test/memoize!-letrec: pass

(define (test/memoize!-letrec _)
  (define fibonacci
    (letrec ((F (λ (i) (cond ((< i 2) i) (else (+ (F (- i 1)) (F (- i 2))))))))
      (memoize! F)))
  (time (⊦= 354224848179261915075 (fibonacci 100))))
((eta 0.005)
 (memory #(12582912 2245136 1048576))
 (stdout "")
 (stderr
   "0s CPU time, 332/103 mutations (total/tracked), 0/1 GCs (major/minor), maximum live heap: 2.14 MiB\n"))

test/memoize!-define: pass

(define (test/memoize!-define _)
  (define F₁
    (memoize! (λ (i) (cond ((< i 2) i) (else (+ (F₁ (- i 1)) (F₁ (- i 2))))))))
  (time (⊦= 1346269 (F₁ 31))))
((eta 0.798)
 (memory #(12582912 2228600 1048576))
 (stdout "")
 (stderr
   "0.792s CPU time, 0.003s GC time (major), 188258/31374 mutations (total/tracked), 2/13048 GCs (major/minor), maximum live heap: 2.13 MiB\n"))

test/pascal: pass

(define (test/pascal _)
  (define-tabled
    pascal
    (lambda (n k)
      (cond ((and (zero? n) (zero? k)) 1)
            ((zero? n) 0)
            ((zero? k) (pascal (sub1 n) 0))
            (else (+ (pascal (sub1 n) (sub1 k)) (pascal (sub1 n) k))))))
  (define Riordan-array
    (λ (recurrence)
       (λ (m)
          (map (λ (n)
                  (append-map (λ (k) (list (recurrence n k))) (iota (add1 n))))
               (iota m)))))
  (⊦= 1 (pascal 0 0))
  (⊦= 2 (pascal 2 1))
  (⊦= 1 (pascal 2 2))
  (⊦= 3 (pascal 3 2))
  (⊦= 100891344545564193334812497256 (pascal 100 50))
  (⊦= '((1)
        (1 1)
        (1 2 1)
        (1 3 3 1)
        (1 4 6 4 1)
        (1 5 10 10 5 1)
        (1 6 15 20 15 6 1)
        (1 7 21 35 35 21 7 1)
        (1 8 28 56 70 56 28 8 1)
        (1 9 36 84 126 126 84 36 9 1)
        (1 10 45 120 210 252 210 120 45 10 1)
        (1 11 55 165 330 462 462 330 165 55 11 1)
        (1 12 66 220 495 792 924 792 495 220 66 12 1)
        (1 13 78 286 715 1287 1716 1716 1287 715 286 78 13 1)
        (1 14 91 364 1001 2002 3003 3432 3003 2002 1001 364 91 14 1)
        (1 15 105 455 1365 3003 5005 6435 6435 5005 3003 1365 455 105 15 1)
        (1
         16
         120
         560
         1820
         4368
         8008
         11440
         12870
         11440
         8008
         4368
         1820
         560
         120
         16
         1)
        (1
         17
         136
         680
         2380
         6188
         12376
         19448
         24310
         24310
         19448
         12376
         6188
         2380
         680
         136
         17
         1)
        (1
         18
         153
         816
         3060
         8568
         18564
         31824
         43758
         48620
         43758
         31824
         18564
         8568
         3060
         816
         153
         18
         1)
        (1
         19
         171
         969
         3876
         11628
         27132
         50388
         75582
         92378
         92378
         75582
         50388
         27132
         11628
         3876
         969
         171
         19
         1))
      ((Riordan-array pascal) 20)))
((eta 0.039) (memory #(12582912 2791336 1048576)) (stdout "") (stderr ""))

test/catalan: pass

(define (test/catalan _)
  (define-tabled
    catalan
    (lambda (n k)
      (cond ((and (zero? n) (zero? k)) 1)
            ((zero? n) 0)
            ((zero? k) (apply + (map (λ (j) (catalan (sub1 n) j)) (iota n))))
            (else
             (apply + (map (λ (j) (catalan (sub1 n) j)) (iota n (sub1 k))))))))
  (define Riordan-array
    (λ (recurrence)
       (λ (m)
          (map (λ (n)
                  (append-map (λ (k) (list (recurrence n k))) (iota (add1 n))))
               (iota m)))))
  (⊦= '((1)
        (1 1)
        (2 2 1)
        (5 5 3 1)
        (14 14 9 4 1)
        (42 42 28 14 5 1)
        (132 132 90 48 20 6 1)
        (429 429 297 165 75 27 7 1)
        (1430 1430 1001 572 275 110 35 8 1)
        (4862 4862 3432 2002 1001 429 154 44 9 1)
        (16796 16796 11934 7072 3640 1638 637 208 54 10 1)
        (58786 58786 41990 25194 13260 6188 2548 910 273 65 11 1)
        (208012 208012 149226 90440 48450 23256 9996 3808 1260 350 77 12 1)
        (742900
         742900
         534888
         326876
         177650
         87210
         38760
         15504
         5508
         1700
         440
         90
         13
         1)
        (2674440
         2674440
         1931540
         1188640
         653752
         326876
         149226
         62016
         23256
         7752
         2244
         544
         104
         14
         1)
        (9694845
         9694845
         7020405
         4345965
         2414425
         1225785
         572033
         245157
         95931
         33915
         10659
         2907
         663
         119
         15
         1)
        (35357670
         35357670
         25662825
         15967980
         8947575
         4601610
         2187185
         961400
         389367
         144210
         48279
         14364
         3705
         798
         135
         16
         1)
        (129644790
         129644790
         94287120
         58929450
         33266625
         17298645
         8351070
         3749460
         1562275
         600875
         211508
         67298
         19019
         4655
         950
         152
         17
         1)
        (477638700
         477638700
         347993910
         218349120
         124062000
         65132550
         31865925
         14567280
         6216210
         2466750
         904475
         303600
         92092
         24794
         5775
         1120
         170
         18
         1)
        (1767263190
         1767263190
         1289624490
         811985790
         463991880
         245642760
         121580760
         56448210
         24582285
         10015005
         3798795
         1332045
         427570
         123970
         31878
         7084
         1309
         189
         19
         1))
      ((Riordan-array catalan) 20)))
((eta 0.081) (memory #(12582912 2847288 1048576)) (stdout "") (stderr ""))

test/ackermann: pass

(define (test/ackermann _)
  (define-tabled
    ackermann
    (lambda (m n)
      (cond ((zero? m) (add1 n))
            ((zero? n) (ackermann (sub1 m) 1))
            (else (ackermann (sub1 m) (ackermann m (sub1 n)))))))
  (⊦= 7 (ackermann 2 2))
  (⊦= 125 (ackermann 3 4)))
((eta 0.002) (memory #(12582912 2308504 1048576)) (stdout "") (stderr ""))

test/fresh-and-store-keywords: pass

(define (test/fresh-and-store-keywords _)
  (define calls 0)
  (define-tabled
    sq
    λH
    (lambda (x)
      (cond ((eq? x tabled/get-hidden-hash-table) (λH))
            (else (set! calls (add1 calls)) (* x x)))))
  (⊦= 9 (sq 3))
  (⊦= 1 calls)
  (⊦= 9 (sq 3))
  (⊦= 1 calls)
  (⊦= 9 (sq 3 #:fresh #t))
  (⊦= 2 calls)
  (⊦= 16 (sq 4 #:store #f))
  (⊦= 3 calls)
  (⊦= 16 (sq 4))
  (⊦= 4 calls)
  (⊦= '((3) (4))
      (sort/lex<=?
        (hash-table-keys (sq tabled/get-hidden-hash-table #:store #f)))))
((eta 0.0) (memory #(12582912 2313000 1048576)) (stdout "") (stderr ""))

test/letrec-tabled: pass

(define (test/letrec-tabled _)
  (⊦= '(#t #f 832040)
      (letrec-tabled
        ((ev? (lambda (n) (if (zero? n) #t (od? (sub1 n)))))
         (od? (lambda (n) (if (zero? n) #f (ev? (sub1 n)))))
         (fib (lambda (n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))))
        (list (ev? 10) (od? 10) (fib 30))))
  (⊦= '(1 ((0) (2)))
      (letrec-tabled
        ((f H
            (lambda (x)
              (if (eq? x tabled/get-hidden-hash-table) (H) (add1 x)))))
        (f 0)
        (f 2)
        (list (f 0)
              (sort/lex<=?
                (hash-table-keys
                  (f tabled/get-hidden-hash-table #:store #f)))))))
((eta 0.001) (memory #(12582912 2251640 1048576)) (stdout "") (stderr ""))

test/lambda-tabled: pass

(define (test/lambda-tabled _)
  (let1 (f (lambda-tabled (x y) (+ x y)))
        (⊦= 3 (f 1 2))
        (⊦= 3 (f 1 2 #:fresh #t)))
  (let1 (f (lambda-tabled H → (x) (list x (hash-table-size (H)))))
        (⊦= '(a 0) (f 'a))
        (⊦= '(a 0) (f 'a))
        (⊦= '(b 1) (f 'b))))
((eta 0.001) (memory #(12582912 2253024 1048576)) (stdout "") (stderr ""))

test/hash-table-ref/store-and-maybe: pass

(define (test/hash-table-ref/store-and-maybe _)
  (let* ((H (make-hash-table #:test equal?)) (↑ (hash-table-ref/store H)))
    (⊦= 3 (↑ '(1 2) +))
    (⊦= 3 (↑ '(1 2) (λ _ 'unused)))
    (⊦= '(#t 3) (call-with-values (τ (hash-table-ref/maybe H '(1 2))) list))
    (⊦= '(#f)
        (call-with-values
          (τ (hash-table-ref/maybe H '(3)))
          (λ (found v) (list found))))
    (⊨ (void? (call-with-values
                (τ (hash-table-ref/maybe H '(3)))
                (λ (found v) v))))))
((eta 0.0) (memory #(12582912 2253240 1048576)) (stdout "") (stderr ""))

test/multiple-values: pass

(define (test/multiple-values _)
  (define calls 0)
  (define (divmod a b)
    (set! calls (add1 calls))
    (values (quotient a b) (remainder a b)))
  (memoize! divmod)
  (⊦= '(3 1) (call-with-values (τ (divmod 7 2)) list))
  (⊦= '(3 1) (call-with-values (τ (divmod 7 2)) list))
  (⊦= 1 calls)
  (define-tabled
    dm
    λH
    (lambda (a b)
      (if (eq? a tabled/get-hidden-hash-table)
        (λH)
        (values (quotient a b) (remainder a b)))))
  (⊦= '(3 1) (call-with-values (τ (dm 7 2)) list))
  (⊦= '(3 1) (call-with-values (τ (dm 7 2)) list))
  (define-tabled none (lambda (a) (values)))
  (⊦= '() (call-with-values (τ (none 1)) list))
  (⊦= '() (call-with-values (τ (none 1)) list))
  (let* ((H (make-hash-table #:test equal?)) (↑ (hash-table-ref/store H)))
    (⊦= '(1 2) (call-with-values (τ (↑ '(1 2) values)) list))
    (⊦= 3 (↑ '(3) values))
    (⊦= 3 (hash-table-ref H '(3)))))
((eta 0.002) (memory #(12582912 2263960 1048576)) (stdout "") (stderr ""))
Categories: scheme 

See also

The (aux anthropic) module The Anthropic Messages API, offline The (aux cml) module Events, threads, synchronous variables, the library and I/O The (aux hakaru10) modules Random sources, distributions, the language, exact inference and examples The (aux kanren) modules Arithmetic, dates, presentation of answers and a union-find miniKanren The (aux games dice-of-doom) module Dice of Doom The (aux machine) modules Environments, the SC machine and the SECD machine The (aux schemer seasoned) module The Seasoned Schemer The (aux continuation) modules Classic operators, escapers, amb and Collatz sequences The (aux category) modules Monads: list, maybe, probability, ziplist, difference lists and state The (aux timsort) module Sorting and the trace buffer The (aux fds) modules Functional queues and union-find The (aux sxml) module Rendering SXML to HTML The (aux variable) module Logic variables introduced by fresh The (aux commons) module Learning tests for CHICKEN Scheme Promises delay and make-promise The Ackermann function On unary numbers, as lists Concurrent ML for CHICKEN Scheme Porting SML/NJ CML as the (aux cml) library CHICKEN Scheme Versions and implementation notes The SBRAL data structure Skew Binary Random-Access Lists Pattern matching Scheme macrology: a generalized pattern matcher The (aux hansei) modules Inference, random sources, lazy lists, logic programming and example models The (aux nondeterministic) module Learning tests for Scheme The (aux stream) modules Streams, streams after SICP, and sequences and power series The (aux unittest) module Bootstrapping a unittest framework Scheme lang: Chez, 48 and Chicken Some docs, refs and containers, respectively. The Reasoned Schemer miniKanren, microKanren and some implementations Aggregation predicates for µkanren Groups, window functions, sets and enumerations miniKanren, live and untagged Quine generation via relational interpreters Pure, declarative, and constructive arithmetic relations A declarative pearl Final shift for call/cc Direct implementation of shift and reset Call with Current Continuation Patterns Cogen in six lines The Seasoned Schemer The Little Schemer Adding generic functions to Scheme Handling control