blob: c74540bd9058fd420914f068d32641b7bc5d90e4 (
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
184
185
186
187
188
|
(.module:
[lux #*
data/text/format
[control/monad (#+ do)]
["r" math/random (#+ Random)]
["_" test (#+ Test)]
[data
["." bit ("#@." equivalence)]
[number
["." nat]
["." rev]]
[collection
["." list]
["." set]]]]
{1
["." / (#+ Fuzzy)
[//
["//" continuous]]]})
(do-template [<name> <desc> <hash> <gen> <triangle> <lt> <lte> <gt> <gte>]
[(def: <name>
Test
(<| (_.context (%name (name-of <triangle>)))
(do r.monad
[values (r.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" rev.hash r.rev /.triangle r/< r/<= r/> r/>=]
)
(do-template [<name> <desc> <hash> <gen> <trapezoid> <lt> <lte> <gt> <gte>]
[(def: <name>
Test
(<| (_.context (%name (name-of <trapezoid>)))
(do r.monad
[values (r.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" rev.hash r.rev /.trapezoid r/< r/<= r/> r/>=]
)
(def: #export triangle
(Random (Fuzzy Rev))
(do r.monad
[x r.rev
y r.rev
z r.rev]
(wrap (/.triangle x y z))))
(def: combinators
Test
(<| (_.context "Combinators")
(do r.monad
[left ..triangle
right ..triangle
sample r.rev]
($_ _.and
(_.test "Union membership as as high as membership in any of its members."
(let [combined (/.union left right)
combined-membership (/.membership sample combined)]
(and (r/>= (/.membership sample left)
combined-membership)
(r/>= (/.membership sample right)
combined-membership))))
(_.test "Intersection membership as as low as membership in any of its members."
(let [combined (/.intersection left right)
combined-membership (/.membership sample combined)]
(and (r/<= (/.membership sample left)
combined-membership)
(r/<= (/.membership sample right)
combined-membership))))
(_.test "Complement membership is the opposite of normal membership."
(r/= (/.membership sample left)
(//.not (/.membership sample (/.complement left)))))
(_.test "Membership in the difference will never be higher than in the set being subtracted."
(bit@= (r/> (/.membership sample right)
(/.membership sample left))
(r/< (/.membership sample left)
(/.membership sample (/.difference left right)))))
))))
(def: predicates-and-sets
Test
(do r.monad
[#let [set-10 (set.from-list nat.hash (list.n/range 0 10))]
sample (|> r.nat (:: @ map (n/% 20)))]
($_ _.and
(<| (_.context (%name (name-of /.from-predicate)))
(_.test (format "Values that satisfy a predicate have membership = 1."
"Values that don't have membership = 0.")
(bit@= (r/= //.true (/.membership sample (/.from-predicate n/even?)))
(n/even? sample))))
(<| (_.context (%name (name-of /.from-set)))
(_.test (format "Values that belong to a set have membership = 1."
"Values that don't have membership = 0.")
(bit@= (r/= //.true (/.membership sample (/.from-set set-10)))
(set.member? set-10 sample))))
)))
(def: thresholds
Test
(do r.monad
[fuzzy ..triangle
sample r.rev
threshold r.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
)))
|
