aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/control/function/memo.lux
blob: 3a74921cff95d87ffde6a853966539d68ccadd73 (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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
(.using
 [library
  [lux (.except)
   ["_" test (.only Test)]
   [abstract
    [monad (.only do)]]
   [control
    ["[0]" io (.only IO)]
    ["[0]" state (.only State) (.open: "[1]#[0]" monad)]]
   [data
    ["[0]" product]
    [collection
     ["[0]" dictionary (.only Dictionary)]
     ["[0]" list (.open: "[1]#[0]" functor mix)]]]
   [macro
    ["^" pattern]]
   [math
    ["[0]" random]
    [number
     ["n" nat]
     ["[0]" i64]]]
   [time
    ["[0]" instant]
    ["[0]" duration (.only Duration)]]]]
 [\\library
  ["[0]" / (.only)
   ["/[1]" //
    ["[1]" mixin]]]])

(def: (fibonacci again input)
  (/.Memo Nat Nat)
  (case input
    0 (state#in 0)
    1 (state#in 1)
    _ (do state.monad
        [output_1 (again (n.- 1 input))
         output_2 (again (n.- 2 input))]
        (in (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]
    (in [(instant.span before after)
         output])))

(def: milli_seconds
  (-> Duration Nat)
  (|>> (duration.ticks duration.milli_second) .nat))

... the wiggle room is there to account for GC pauses
... and other issues that might mess with duration
(def: wiggle_room
  Nat
  (i64.left_shifted 4 1))

(def: .public test
  Test
  (<| (_.covering /._)
      (do [! random.monad]
        [input (|> random.nat (at ! each (|>> (n.% 5) (n.+ 21))))])
      (_.for [/.Memo])
      (all _.and
           (_.coverage [/.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)
                 .let [same_output!
                       (n.= slow_output
                            fast_output)

                       memo_is_faster!
                       (n.< (n.+ ..wiggle_room (milli_seconds slow_time))
                            (milli_seconds fast_time))]]
                (in (and same_output!
                         memo_is_faster!)))))
           (_.coverage [/.open]
             (io.run!
              (do io.monad
                [.let [none (/.none n.hash ..fibonacci)
                       memory (dictionary.empty 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 (++ input)])
                 .let [same_output!
                       (n.= none_output
                            open_output)

                       memo_is_faster!
                       (n.< (n.+ ..wiggle_room (milli_seconds none_time))
                            (milli_seconds open_time))

                       incrementalism_is_faster!
                       (n.< (n.+ ..wiggle_room (milli_seconds open_time))
                            (milli_seconds open_time/+1))]]
                (in (and same_output!
                         memo_is_faster!
                         incrementalism_is_faster!)))))
           (_.coverage [/.memoization]
             (let [memo (<| //.fixed
                            (//.mixed /.memoization)
                            (is (//.Mixin Nat (State (Dictionary Nat Nat) Nat))
                                (function (factorial delegate again input)
                                  (case input
                                    (^.or 0 1) (at state.monad in 1)
                                    _ (do state.monad
                                        [output' (again (-- input))]
                                        (in (n.* input output')))))))
                   expected (|> (list.indices input)
                                (list#each ++)
                                (list#mix n.* 1))
                   actual (|> (memo input)
                              (state.result (dictionary.empty n.hash))
                              product.right)]
               (n.= expected actual)))
           )))