aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/data/collection/dictionary/ordered.lux
blob: a004e5c97f30cb91e3830e293aa8b9bdd07b1aa1 (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
123
124
125
126
127
128
129
130
131
132
133
134
135
(.module:
  [lux #*
   ["_" test (#+ Test)]
   [abstract
    [monad (#+ do)]
    [equivalence (#+ Equivalence)]
    [order (#+ Order)]
    [\spec
     ["$." equivalence]]]
   [data
    ["." product]
    ["." bit ("#\." equivalence)]
    ["." maybe ("#\." monad)]
    [collection
     ["." set]
     ["." list ("#\." functor)]]]
   [math
    ["." random (#+ Random) ("#\." monad)]
    [number
     ["n" nat]]]]
  [\\
   ["." /]])

(def: #export (dictionary order gen_key gen_value size)
  (All [k v]
    (-> (Order k) (Random k) (Random v) Nat (Random (/.Dictionary k v))))
  (case size
    0
    (random\wrap (/.new order))
    
    _
    (do random.monad
      [partial (dictionary order gen_key gen_value (dec size))
       key (random.filter (|>> (/.key? partial) not)
                          gen_key)
       value gen_value]
      (wrap (/.put key value partial)))))

(def: #export test
  Test
  (<| (_.covering /._)
      (_.for [/.Dictionary])
      (do {! random.monad}
        [size (\ ! map (n.% 100) random.nat)
         keys (random.set n.hash size random.nat)
         values (random.set n.hash size random.nat)
         extra_key (random.filter (|>> (set.member? keys) not)
                                  random.nat)
         extra_value random.nat
         shift random.nat
         #let [pairs (list.zip/2 (set.to_list keys)
                                 (set.to_list values))
               sample (/.from_list n.order pairs)
               sorted_pairs (list.sort (function (_ [left _] [right _])
                                         (n.< left right))
                                       pairs)
               sorted_values (list\map product.right sorted_pairs)
               (^open "list\.") (list.equivalence (: (Equivalence [Nat Nat])
                                                     (function (_ [kr vr] [ks vs])
                                                       (and (n.= kr ks)
                                                            (n.= vr vs)))))
               (^open "/\.") (/.equivalence n.equivalence)]]
        ($_ _.and
            (_.for [/.equivalence]
                   ($equivalence.spec (/.equivalence n.equivalence) (..dictionary n.order random.nat random.nat size)))
            
            (_.cover [/.size]
                     (n.= size (/.size sample)))
            (_.cover [/.empty?]
                     (bit\= (n.= 0 (/.size sample))
                            (/.empty? sample)))
            (_.cover [/.new]
                     (/.empty? (/.new n.order)))
            (_.cover [/.min]
                     (case [(/.min sample) (list.head sorted_values)]
                       [#.None #.None]
                       #1

                       [(#.Some reference) (#.Some sample)]
                       (n.= reference sample)

                       _
                       #0))
            (_.cover [/.max]
                     (case [(/.max sample) (list.last sorted_values)]
                       [#.None #.None]
                       #1

                       [(#.Some reference) (#.Some sample)]
                       (n.= reference sample)

                       _
                       #0))
            (_.cover [/.entries]
                     (list\= (/.entries sample)
                             sorted_pairs))
            (_.cover [/.keys /.values]
                     (list\= (/.entries sample)
                             (list.zip/2 (/.keys sample) (/.values sample))))
            (_.cover [/.from_list]
                     (|> sample
                         /.entries (/.from_list n.order)
                         (/\= sample)))
            (_.cover [/.key?]
                     (and (list.every? (/.key? sample)
                                       (/.keys sample))
                          (not (/.key? sample extra_key))))
            (_.cover [/.put]
                     (and (not (/.key? sample extra_key))
                          (let [sample+ (/.put extra_key extra_value sample)]
                            (and (/.key? sample+ extra_key)
                                 (n.= (inc (/.size sample))
                                      (/.size sample+))))))
            (_.cover [/.get]
                     (let [sample+ (/.put extra_key extra_value sample)]
                       (case [(/.get extra_key sample)
                              (/.get extra_key sample+)]
                         [#.None (#.Some actual)]
                         (n.= extra_value actual)
                         
                         _
                         false)))
            (_.cover [/.remove]
                     (|> sample
                         (/.put extra_key extra_value)
                         (/.remove extra_key)
                         (/\= sample)))
            (_.cover [/.update]
                     (|> sample
                         (/.put extra_key extra_value)
                         (/.update extra_key (n.+ shift))
                         (/.get extra_key)
                         (maybe\map (n.= (n.+ shift extra_value)))
                         (maybe.default false)))
            ))))