aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/control/function/memo.lux
blob: 90a2064af62e99dcf115578e493ef6b41ef5a5d9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
(.module:
  [lux #*
   ["_" test (#+ Test)]
   [abstract
    [monad (#+ do)]]
   [control
    ["." io (#+ IO)]
    ["." state (#+ State) ("#@." monad)]]
   [math
    ["." random]]
   [data
    ["." product]
    [number
     ["n" nat]]
    [collection
     ["." dictionary (#+ Dictionary)]
     ["." list ("#@." functor fold)]]]
   [time
    ["." instant]
    ["." duration (#+ Duration)]]]
  {1
   ["." /
    ["/#" // #_
     ["#" mixin]]]})

(def: (fibonacci recur input)
  (/.Memo Nat Nat)
  (case input
    0 (state@wrap 0)
    1 (state@wrap 1)
    _ (do state.monad
        [output-1 (recur (n.- 1 input))
         output-2 (recur (n.- 2 input))]
        (wrap (n.+ output-1 output-2)))))

(def: (time function input)
  (All [i o] (-> (-> i o) i (IO [Duration o])))
  (do io.monad
    [before instant.now
     #let [output (function input)]
     after instant.now]
    (wrap [(instant.span before after)
           output])))

(def: milli-seconds
  (-> Duration Nat)
  (|>> (duration.query duration.milli-second) .nat))

(def: #export test
  Test
  (<| (_.covering /._)
      (do {! random.monad}
        [input (|> random.nat (:: ! map (|>> (n.% 5) (n.+ 23))))])
      (_.with-cover [/.Memo])
      ($_ _.and
          (_.cover [/.closed /.none]
                   (io.run
                    (do io.monad
                      [#let [slow (/.none n.hash ..fibonacci)
                             fast (/.closed n.hash fibonacci)]
                       [slow-time slow-output] (..time slow input)
                       [fast-time fast-output] (..time fast input)]
                      (wrap (and (n.= slow-output
                                      fast-output)
                                 (n.< (milli-seconds slow-time)
                                      (milli-seconds fast-time)))))))
          (_.cover [/.open]
                   (io.run
                    (do io.monad
                      [#let [none (/.none n.hash ..fibonacci)
                             memory (dictionary.new n.hash)
                             open (/.open fibonacci)]
                       [none-time none-output] (..time none input)
                       [open-time [memory open-output]] (..time open [memory input])
                       [open-time/+1 _] (..time open [memory (inc input)])]
                      (wrap (and (n.= none-output
                                      open-output)
                                 (n.< (milli-seconds none-time)
                                      (milli-seconds open-time))
                                 (n.< (milli-seconds open-time)
                                      (milli-seconds open-time/+1)))))))
          (_.cover [/.memoization]
                   (let [memo (<| //.mixin
                                  (//.inherit /.memoization)
                                  (: (//.Mixin Nat (State (Dictionary Nat Nat) Nat))
                                     (function (factorial delegate recur input)
                                       (case input
                                         (^or 0 1) (:: state.monad wrap 1)
                                         _ (do state.monad
                                             [output' (recur (dec input))]
                                             (wrap (n.* input output')))))))
                         expected (|> (list.indices input)
                                      (list@map inc)
                                      (list@fold n.* 1))
                         actual (|> (memo input)
                                    (state.run (dictionary.new n.hash))
                                    product.right)]
                     (n.= expected actual)))
          )))