aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/math/logic/fuzzy.lux
blob: 9ee9b16850f557c6b3a8a56a8257573bdd7f48b9 (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
(.module:
  lux
  (lux (data [number "Rev/" Interval<Rev>]
             (coll [list]
                   [set #+ Set])
             text/format)
       [math])
  (// ["&" 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] (-> (-> a Bool) (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) (-> a Bool)))
  (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])))