blob: f319af29539d7e011e6be322c6d346cf6a37b5e4 (
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
|
(.module:
[lux #*
data/text/format
["_" test (#+ Test)]
[control
[monad (#+ do)]
{[0 #test]
[/
["$." equivalence]
["$." monoid]]}]
[data
[number
["." nat]]
[collection
["." list]]]
[math
["r" random]]]
{1
["." /]})
(def: gen-nat
(r.Random Nat)
(|> r.nat
(:: r.monad map (n/% 100))))
(def: #export test
Test
(<| (_.context (%name (name-of /.Set)))
(do r.monad
[size gen-nat]
($_ _.and
($equivalence.spec /.equivalence (r.set nat.hash size r.nat))
($monoid.spec /.equivalence (/.monoid nat.hash) (r.set nat.hash size r.nat))
(do r.monad
[sizeL gen-nat
sizeR gen-nat
setL (r.set nat.hash sizeL gen-nat)
setR (r.set nat.hash sizeR gen-nat)
non-member (|> gen-nat
(r.filter (|>> (/.member? setL) not)))
#let [(^open "/@.") /.equivalence]]
($_ _.and
(_.test "I can query the size of a set."
(and (n/= sizeL (/.size setL))
(n/= sizeR (/.size setR))))
(_.test "Converting sets to/from lists can't change their values."
(|> setL
/.to-list (/.from-list nat.hash)
(/@= setL)))
(_.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.hash)
setL)))
(_.test "Intersection with the empty set results in the empty set."
(let [empty-set (/.new nat.hash)]
(/@= 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."
(and (not (/.member? setL non-member))
(/.member? (/.add non-member setL) non-member)
(not (/.member? (/.remove non-member (/.add non-member setL)) non-member))))
))))))
|
