aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/math/logic/fuzzy.lux
blob: 617cd8929bb036cb4668dfd784595b8d00c68adc (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
(.module:
  [lux #*
   [abstract
    [predicate (#+ Predicate)]]
   [data
    [collection
     ["." list]
     ["." set (#+ Set)]]]
   [math
    [number
     ["r" rev]]]]
  [//
   ["&" continuous]])

(type: #export (Fuzzy a)
  (-> a Rev))

(def: #export (membership elem set)
  (All [a] (-> a (Fuzzy a) Rev))
  (set elem))

(def: #export (union left right)
  (All [a] (-> (Fuzzy a) (Fuzzy a) (Fuzzy a)))
  (function (_ elem)
    (&.or (membership elem left)
          (membership elem right))))

(def: #export (intersection left right)
  (All [a] (-> (Fuzzy a) (Fuzzy a) (Fuzzy a)))
  (function (_ elem)
    (&.and (membership elem left)
           (membership elem right))))

(def: #export (complement set)
  (All [a] (-> (Fuzzy a) (Fuzzy a)))
  (function (_ elem)
    (&.not (membership elem set))))

(def: #export (difference sub base)
  (All [a] (-> (Fuzzy a) (Fuzzy a) (Fuzzy a)))
  (function (_ elem)
    (&.and (membership elem base)
           (&.not (membership elem sub)))))

(def: #export (from_predicate predicate)
  (All [a] (-> (Predicate a) (Fuzzy a)))
  (function (_ elem)
    (if (predicate elem)
      &.true
      &.false)))

(def: #export (from_set set)
  (All [a] (-> (Set a) (Fuzzy a)))
  (from_predicate (set.member? set)))

(def: (ascending from to)
  (-> Rev Rev (Fuzzy Rev))
  (function (_ elem)
    (cond (r.<= from elem)
          &.false

          (r.>= to elem)
          &.true

          ## in the middle...
          (r./ (r.- from to)
               (r.- from elem)))))

(def: (descending from to)
  (-> Rev Rev (Fuzzy Rev))
  (function (_ elem)
    (cond (r.<= from elem)
          &.true

          (r.>= to elem)
          &.false

          ## in the middle...
          (r./ (r.- from to)
               (r.- elem to)))))

(def: #export (gradient from to)
  (-> Rev Rev (Fuzzy Rev))
  (if (r.< to from)
    (ascending from to)
    (descending from to)))

(def: #export (triangle bottom middle top)
  (-> Rev Rev Rev (Fuzzy Rev))
  (case (list.sort r.< (list bottom middle top))
    (^ (list bottom middle top))
    (intersection (ascending bottom middle)
                  (descending middle top))

    _
    (undefined)))

(def: #export (trapezoid bottom middle_bottom middle_top top)
  (-> Rev Rev Rev Rev (Fuzzy Rev))
  (case (list.sort r.< (list bottom middle_bottom middle_top top))
    (^ (list bottom middle_bottom middle_top top))
    (intersection (ascending bottom middle_bottom)
                  (descending middle_top top))

    _
    (undefined)))

(def: #export (cut treshold set)
  (All [a] (-> Rev (Fuzzy a) (Fuzzy a)))
  (function (_ elem)
    (let [membership (set elem)]
      (if (r.> treshold membership)
        (|> membership (r.- treshold) (r.* &.true))
        &.false))))

(def: #export (to_predicate treshold set)
  (All [a] (-> Rev (Fuzzy a) (Predicate a)))
  (function (_ elem)
    (r.> treshold (set elem))))

(type: #export (Fuzzy2 a)
  (-> a [Rev Rev]))

(def: #export (type_2 lower upper)
  (All [a] (-> (Fuzzy a) (Fuzzy a) (Fuzzy2 a)))
  (function (_ elem)
    (let [l_rev (lower elem)
          u_rev (upper elem)]
      [(r.min l_rev
              u_rev)
       u_rev])))