blob: fa7c007984209f2644e576dab5e6ed7311209efd (
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
|
(.module:
[lux #*
["%" data/text/format (#+ format)]
["_" test (#+ Test)]
[abstract
[monad (#+ do)]
[order (#+ Order)]
{[0 #test]
[/
["$." equivalence]]}]
[data
[number
["." nat]]
[collection
["." list]]]
[math
["r" random (#+ Random) ("#@." monad)]]]
{1
["." / (#+ Set)
["." //]]})
(def: gen-nat
(r.Random Nat)
(|> r.nat
(:: r.monad map (n/% 100))))
(def: #export (set &order gen-value size)
(All [a] (-> (Order a) (Random a) Nat (Random (Set a))))
(case size
0
(r@wrap (/.new &order))
_
(do r.monad
[partial (set &order gen-value (dec size))
value (r.filter (|>> (/.member? partial) not)
gen-value)]
(wrap (/.add value partial)))))
(def: #export test
Test
(<| (_.context (%.name (name-of /.Set)))
($_ _.and
(do r.monad
[size gen-nat]
($_ _.and
($equivalence.spec /.equivalence (..set nat.order r.nat size))
))
(do r.monad
[sizeL gen-nat
sizeR gen-nat
listL (|> (r.set nat.hash sizeL gen-nat) (:: @ map //.to-list))
listR (|> (r.set nat.hash sizeR gen-nat) (:: @ map //.to-list))
#let [(^open "/@.") /.equivalence
setL (/.from-list nat.order listL)
setR (/.from-list nat.order listR)
sortedL (list.sort n/< listL)
minL (list.head sortedL)
maxL (list.last sortedL)]]
($_ _.and
(_.test "I can query the size of a set."
(n/= sizeL (/.size setL)))
(_.test "Can query minimum value."
(case [(/.min setL) minL]
[#.None #.None]
true
[(#.Some reference) (#.Some sample)]
(n/= reference sample)
_
false))
(_.test "Can query maximum value."
(case [(/.max setL) maxL]
[#.None #.None]
true
[(#.Some reference) (#.Some sample)]
(n/= reference sample)
_
false))
(_.test "Converting sets to/from lists can't change their values."
(|> setL
/.to-list (/.from-list nat.order)
(/@= setL)))
(_.test "Order is preserved."
(let [listL (/.to-list setL)
(^open "list@.") (list.equivalence nat.equivalence)]
(list@= listL
(list.sort n/< listL))))
(_.test "Every set is a sub-set of the union of itself with another."
(let [setLR (/.union setL setR)]
(and (/.sub? setLR setL)
(/.sub? setLR setR))))
(_.test "Every set is a super-set of the intersection of itself with another."
(let [setLR (/.intersection setL setR)]
(and (/.super? setLR setL)
(/.super? setLR setR))))
(_.test "Union with the empty set leaves a set unchanged."
(/@= setL
(/.union (/.new nat.order)
setL)))
(_.test "Intersection with the empty set results in the empty set."
(let [empty-set (/.new nat.order)]
(/@= empty-set
(/.intersection empty-set setL))))
(_.test "After substracting a set A from another B, no member of A can be a member of B."
(let [sub (/.difference setR setL)]
(not (list.any? (/.member? sub) (/.to-list setR)))))
(_.test "Every member of a set must be identifiable."
(list.every? (/.member? setL) (/.to-list setL)))
)))))
|
