blob: 35dff4a033c43d9c6071284e6d832578459b0c24 (
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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
(.module:
[lux #*
["%" data/text/format (#+ format)]
[abstract/monad (#+ do)]
[math
["." random (#+ Random)]]
["_" test (#+ Test)]
[data
["." bit ("#@." equivalence)]
[number
["." nat]
["r" rev]]
[collection
["." list]
["." set]]]]
{1
["." / (#+ Fuzzy)
[//
["//" continuous]]]})
(template [<name> <desc> <hash> <gen> <triangle> <lt> <lte> <gt> <gte>]
[(def: <name>
Test
(<| (_.context (%.name (name-of <triangle>)))
(do random.monad
[values (random.set <hash> 3 <gen>)
#let [[x y z] (case (set.to-list values)
(^ (list x y z))
[x y z]
_
(undefined))]
sample <gen>
#let [[bottom middle top] (case (list.sort <lt> (list x y z))
(^ (list bottom middle top))
[bottom middle top]
_
(undefined))
triangle (<triangle> x y z)]]
($_ _.and
(_.test "The middle value will always have maximum membership."
(r.= //.true (/.membership middle triangle)))
(_.test "Boundary values will always have 0 membership."
(and (r.= //.false (/.membership bottom triangle))
(r.= //.false (/.membership top triangle))))
(_.test "Values within range, will have membership > 0."
(bit@= (r.> //.false (/.membership sample triangle))
(and (<gt> bottom sample)
(<lt> top sample))))
(_.test "Values outside of range, will have membership = 0."
(bit@= (r.= //.false (/.membership sample triangle))
(or (<lte> bottom sample)
(<gte> top sample))))
))))]
[rev-triangles "Rev" r.hash random.rev /.triangle r.< r.<= r.> r.>=]
)
(template [<name> <desc> <hash> <gen> <trapezoid> <lt> <lte> <gt> <gte>]
[(def: <name>
Test
(<| (_.context (%.name (name-of <trapezoid>)))
(do random.monad
[values (random.set <hash> 4 <gen>)
#let [[w x y z] (case (set.to-list values)
(^ (list w x y z))
[w x y z]
_
(undefined))]
sample <gen>
#let [[bottom middle-bottom middle-top top] (case (list.sort <lt> (list w x y z))
(^ (list bottom middle-bottom middle-top top))
[bottom middle-bottom middle-top top]
_
(undefined))
trapezoid (<trapezoid> w x y z)]]
($_ _.and
(_.test "The middle values will always have maximum membership."
(and (r.= //.true (/.membership middle-bottom trapezoid))
(r.= //.true (/.membership middle-top trapezoid))))
(_.test "Boundary values will always have 0 membership."
(and (r.= //.false (/.membership bottom trapezoid))
(r.= //.false (/.membership top trapezoid))))
(_.test "Values within inner range will have membership = 1"
(bit@= (r.= //.true (/.membership sample trapezoid))
(and (<gte> middle-bottom sample)
(<lte> middle-top sample))))
(_.test "Values within range, will have membership > 0."
(bit@= (r.> //.false (/.membership sample trapezoid))
(and (<gt> bottom sample)
(<lt> top sample))))
(_.test "Values outside of range, will have membership = 0."
(bit@= (r.= //.false (/.membership sample trapezoid))
(or (<lte> bottom sample)
(<gte> top sample))))
))))]
[rev-trapezoids "Rev" r.hash random.rev /.trapezoid r.< r.<= r.> r.>=]
)
(def: #export triangle
(Random (Fuzzy Rev))
(do random.monad
[x random.rev
y random.rev
z random.rev]
(wrap (/.triangle x y z))))
(def: combinators
Test
(<| (_.context "Combinators")
(do random.monad
[left ..triangle
right ..triangle
sample random.rev]
($_ _.and
(_.test (%.name (name-of /.union))
(let [combined (/.union left right)
combined-membership (/.membership sample combined)]
(and (r.>= (/.membership sample left)
combined-membership)
(r.>= (/.membership sample right)
combined-membership))))
(_.test (%.name (name-of /.intersection))
(let [combined (/.intersection left right)
combined-membership (/.membership sample combined)]
(and (r.<= (/.membership sample left)
combined-membership)
(r.<= (/.membership sample right)
combined-membership))))
(_.test (%.name (name-of /.complement))
(r.= (/.membership sample left)
(//.not (/.membership sample (/.complement left)))))
(_.test (%.name (name-of /.difference))
(r.<= (/.membership sample right)
(/.membership sample (/.difference left right))))
))))
(def: predicates-and-sets
Test
(do random.monad
[#let [set-10 (set.from-list nat.hash (list.n/range 0 10))]
sample (|> random.nat (:: @ map (n/% 20)))]
($_ _.and
(_.test (%.name (name-of /.from-predicate))
(bit@= (r.= //.true (/.membership sample (/.from-predicate n/even?)))
(n/even? sample)))
(_.test (%.name (name-of /.from-set))
(bit@= (r.= //.true (/.membership sample (/.from-set set-10)))
(set.member? set-10 sample)))
)))
(def: thresholds
Test
(do random.monad
[fuzzy ..triangle
sample random.rev
threshold random.rev
#let [vip-fuzzy (/.cut threshold fuzzy)
member? (/.to-predicate threshold fuzzy)]]
(<| (_.context (%.name (name-of /.cut)))
($_ _.and
(_.test "Can increase the threshold of membership of a fuzzy set."
(bit@= (r.> //.false (/.membership sample vip-fuzzy))
(r.> threshold (/.membership sample fuzzy))))
(_.test "Can turn fuzzy sets into predicates through a threshold."
(bit@= (member? sample)
(r.> threshold (/.membership sample fuzzy))))
))))
(def: #export test
Test
(<| (_.context (%.name (name-of /._)))
($_ _.and
..rev-triangles
..rev-trapezoids
..combinators
..predicates-and-sets
..thresholds
)))
|
