diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux/math/logic/fuzzy.lux | 124 |
1 files changed, 50 insertions, 74 deletions
diff --git a/stdlib/source/lux/math/logic/fuzzy.lux b/stdlib/source/lux/math/logic/fuzzy.lux index 7933027c9..7c5ee4150 100644 --- a/stdlib/source/lux/math/logic/fuzzy.lux +++ b/stdlib/source/lux/math/logic/fuzzy.lux @@ -48,81 +48,57 @@ (All [a] (-> (Set a) (Fuzzy a))) (from-predicate (set.member? set))) -(do-template [<ascending> <descending> <gradient> <type> <lt> <gt> <lte> <gte> <sub> <div> <post>] - [(def: (<ascending> from to) - (-> <type> <type> (Fuzzy <type>)) - (function (_ elem) - (cond (<lte> from elem) - &.~false - - (<gte> to elem) - &.~true - - ## in the middle... - (<post> (<div> (<sub> from to) - (<sub> from elem)))))) - - (def: (<descending> from to) - (-> <type> <type> (Fuzzy <type>)) - (function (_ elem) - (cond (<lte> from elem) - &.~true - - (<gte> to elem) - &.~false - - ## in the middle... - (<post> (<div> (<sub> from to) - (<sub> elem to)))))) - - (def: #export (<gradient> from to) - (-> <type> <type> (Fuzzy <type>)) - (if (<lt> to from) - (<ascending> from to) - (<descending> from to)))] - - [d/ascending d/descending d/gradient Deg d/< d/> d/<= d/>= d/- d// id] - [f/ascending f/descending f/gradient Frac f/< f/> f/<= f/>= f/- f// frac-to-deg] - ) - -(do-template [<triangle> <trapezoid> <type> <ascending> <descending> <lt>] - [(def: #export (<triangle> bottom middle top) - (-> <type> <type> <type> (Fuzzy <type>)) - (case (list.sort <lt> (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) - (-> <type> <type> <type> <type> (Fuzzy <type>)) - (case (list.sort <lt> (list bottom middle-bottom middle-top top)) - (^ (list bottom middle-bottom middle-top top)) - (intersection (<ascending> bottom middle-bottom) - (<descending> middle-top top)) - - _ - (undefined)))] - - [d/triangle d/trapezoid Deg d/ascending d/descending d/<] - [f/triangle f/trapezoid Frac f/ascending f/descending f/<] - ) - -(def: #export (gaussian deviation center) - (-> Frac Frac (Fuzzy Frac)) +(def: (ascending from to) + (-> Deg Deg (Fuzzy Deg)) (function (_ elem) - (let [scale (|> deviation (math.pow 2.0) (f/* 2.0)) - membership (|> elem - (f/- center) - (math.pow 2.0) - (f/* -1.0) - (f// scale) - math.exp)] - (if (f/= 1.0 membership) - &.~true - (frac-to-deg membership))))) + (cond (d/<= from elem) + &.~false + + (d/>= to elem) + &.~true + + ## in the middle... + (d// (d/- from to) + (d/- from elem))))) + +(def: (descending from to) + (-> Deg Deg (Fuzzy Deg)) + (function (_ elem) + (cond (d/<= from elem) + &.~true + + (d/>= to elem) + &.~false + + ## in the middle... + (d// (d/- from to) + (d/- elem to))))) + +(def: #export (gradient from to) + (-> Deg Deg (Fuzzy Deg)) + (if (d/< to from) + (ascending from to) + (descending from to))) + +(def: #export (triangle bottom middle top) + (-> Deg Deg Deg (Fuzzy Deg)) + (case (list.sort d/< (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) + (-> Deg Deg Deg Deg (Fuzzy Deg)) + (case (list.sort d/< (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] (-> Deg (Fuzzy a) (Fuzzy a))) |