aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/library/lux/data/collection/sequence.lux4
-rw-r--r--stdlib/source/library/lux/data/color.lux13
-rw-r--r--stdlib/source/library/lux/data/color/cmyk.lux24
-rw-r--r--stdlib/source/library/lux/data/color/hsb.lux14
-rw-r--r--stdlib/source/library/lux/data/color/hsl.lux37
-rw-r--r--stdlib/source/library/lux/data/color/named.lux3
-rw-r--r--stdlib/source/library/lux/data/color/rgb.lux171
-rw-r--r--stdlib/source/library/lux/data/color/terminal.lux6
-rw-r--r--stdlib/source/library/lux/web/css.lux (renamed from stdlib/source/library/lux/data/format/css.lux)0
-rw-r--r--stdlib/source/library/lux/web/css/class.lux (renamed from stdlib/source/library/lux/data/format/css/class.lux)0
-rw-r--r--stdlib/source/library/lux/web/css/font.lux (renamed from stdlib/source/library/lux/data/format/css/font.lux)0
-rw-r--r--stdlib/source/library/lux/web/css/id.lux (renamed from stdlib/source/library/lux/data/format/css/id.lux)0
-rw-r--r--stdlib/source/library/lux/web/css/property.lux (renamed from stdlib/source/library/lux/data/format/css/property.lux)0
-rw-r--r--stdlib/source/library/lux/web/css/query.lux (renamed from stdlib/source/library/lux/data/format/css/query.lux)0
-rw-r--r--stdlib/source/library/lux/web/css/selector.lux (renamed from stdlib/source/library/lux/data/format/css/selector.lux)0
-rw-r--r--stdlib/source/library/lux/web/css/style.lux (renamed from stdlib/source/library/lux/data/format/css/style.lux)0
-rw-r--r--stdlib/source/library/lux/web/css/value.lux (renamed from stdlib/source/library/lux/data/format/css/value.lux)17
-rw-r--r--stdlib/source/library/lux/web/html.lux (renamed from stdlib/source/library/lux/data/format/html.lux)5
-rw-r--r--stdlib/source/library/lux/world/net/http/response.lux7
-rw-r--r--stdlib/source/library/lux/world/time/series.lux189
-rw-r--r--stdlib/source/library/lux/world/time/series/average.lux129
-rw-r--r--stdlib/source/test/lux/data/collection/sequence.lux20
-rw-r--r--stdlib/source/test/lux/data/color.lux10
-rw-r--r--stdlib/source/test/lux/data/color/pigment.lux3
-rw-r--r--stdlib/source/test/lux/data/color/rgb.lux100
-rw-r--r--stdlib/source/test/lux/world/net/http/response.lux11
-rw-r--r--stdlib/source/test/lux/world/time/series.lux213
-rw-r--r--stdlib/source/test/lux/world/time/series/average.lux100
28 files changed, 637 insertions, 439 deletions
diff --git a/stdlib/source/library/lux/data/collection/sequence.lux b/stdlib/source/library/lux/data/collection/sequence.lux
index 72d48f6f1..2d114ca91 100644
--- a/stdlib/source/library/lux/data/collection/sequence.lux
+++ b/stdlib/source/library/lux/data/collection/sequence.lux
@@ -225,11 +225,11 @@
#root (empty_hierarchy [])
#tail (array.empty 0)])
-(def .public (size sequence)
+(def .public size
(All (_ of)
(-> (Sequence of)
Nat))
- (the #size sequence))
+ (the #size))
(def .public (suffix val sequence)
(All (_ of)
diff --git a/stdlib/source/library/lux/data/color.lux b/stdlib/source/library/lux/data/color.lux
index 5d7c33920..a886acb79 100644
--- a/stdlib/source/library/lux/data/color.lux
+++ b/stdlib/source/library/lux/data/color.lux
@@ -5,8 +5,6 @@
[monoid (.only Monoid)]
["[0]" equivalence (.only Equivalence)]
["[0]" hash (.only Hash)]]
- [control
- ["[0]" try]]
[data
[collection
["[0]" list (.use "[1]#[0]" functor)]]]
@@ -99,12 +97,11 @@
(f.+ (|> end .int int.frac (f.* dE)))
f.int
.nat)))
- [redS greenS blueS] (rgb start)
- [redE greenE blueE] (rgb end)]
- (|> (rgb.rgb (interpolated' (rgb.number redE) (rgb.number redS))
- (interpolated' (rgb.number greenE) (rgb.number greenS))
- (interpolated' (rgb.number blueE) (rgb.number blueS)))
- try.trusted
+ start (rgb start)
+ end (rgb end)]
+ (|> (rgb.rgb (interpolated' (rgb.red end) (rgb.red start))
+ (interpolated' (rgb.green end) (rgb.green start))
+ (interpolated' (rgb.blue end) (rgb.blue start)))
of_rgb)))
(with_template [<name> <target>]
diff --git a/stdlib/source/library/lux/data/color/cmyk.lux b/stdlib/source/library/lux/data/color/cmyk.lux
index 6dc6b1f2a..ae47d9604 100644
--- a/stdlib/source/library/lux/data/color/cmyk.lux
+++ b/stdlib/source/library/lux/data/color/cmyk.lux
@@ -4,7 +4,6 @@
[abstract
[equivalence (.only Equivalence)]]
[control
- ["[0]" try]
[function
[predicate (.only Predicate)]]]
[data
@@ -16,7 +15,7 @@
[//
["[0]" rgb (.only RGB)]])
-(def .public Value
+(type .public Value
Frac)
(with_template [<value> <name>]
@@ -79,9 +78,9 @@
(def .public (cmyk it)
(-> RGB
CMYK)
- (let [red (..down (rgb.number (the rgb.#red it)))
- green (..down (rgb.number (the rgb.#green it)))
- blue (..down (rgb.number (the rgb.#blue it)))
+ (let [red (..down (rgb.red it))
+ green (..down (rgb.green it))
+ blue (..down (rgb.blue it))
key (opposite (all f.max red green blue))
f (if (f.< ..most key)
(f./ (opposite key)
@@ -100,14 +99,7 @@
rgb.black
key
- (let [~key (opposite key)
- red (f.* ~key
- (opposite (the #cyan it)))
- green (f.* ~key
- (opposite (the #magenta it)))
- blue (f.* ~key
- (opposite (the #yellow it)))]
- (|> (rgb.rgb (..up red)
- (..up green)
- (..up blue))
- try.trusted))))
+ (let [~key (opposite key)]
+ (rgb.rgb (..up (f.* ~key (opposite (the #cyan it))))
+ (..up (f.* ~key (opposite (the #magenta it))))
+ (..up (f.* ~key (opposite (the #yellow it))))))))
diff --git a/stdlib/source/library/lux/data/color/hsb.lux b/stdlib/source/library/lux/data/color/hsb.lux
index 9f07a50eb..5421c2dc3 100644
--- a/stdlib/source/library/lux/data/color/hsb.lux
+++ b/stdlib/source/library/lux/data/color/hsb.lux
@@ -4,7 +4,6 @@
[abstract
[equivalence (.only Equivalence)]]
[control
- ["[0]" try]
[function
[predicate (.only Predicate)]]]
[math
@@ -98,9 +97,9 @@
(def .public (of_rgb it)
(-> RGB
HSB)
- (let [red (..down (rgb.number (the rgb.#red it)))
- green (..down (rgb.number (the rgb.#green it)))
- blue (..down (rgb.number (the rgb.#blue it)))
+ (let [red (..down (rgb.red it))
+ green (..down (rgb.green it))
+ blue (..down (rgb.blue it))
max (all f.max red green blue)
min (all f.min red green blue)
@@ -145,8 +144,7 @@
red (when mod 0 v 1 q 2 p 3 p 4 t 5 v _ (undefined))
green (when mod 0 t 1 v 2 v 3 q 4 p 5 p _ (undefined))
blue (when mod 0 p 1 p 2 t 3 v 4 v 5 q _ (undefined))]
- (try.trusted
- (rgb.rgb (..up red)
- (..up green)
- (..up blue)))))
+ (rgb.rgb (..up red)
+ (..up green)
+ (..up blue))))
)
diff --git a/stdlib/source/library/lux/data/color/hsl.lux b/stdlib/source/library/lux/data/color/hsl.lux
index 4a4c13097..ce57f5210 100644
--- a/stdlib/source/library/lux/data/color/hsl.lux
+++ b/stdlib/source/library/lux/data/color/hsl.lux
@@ -5,12 +5,8 @@
[equivalence (.only Equivalence)]
[monad (.only do)]]
[control
- ["[0]" try]
[function
[predicate (.only Predicate)]]]
- [data
- [text
- ["%" \\format]]]
[math
[number
["i" int]
@@ -102,9 +98,9 @@
(def .public (of_rgb it)
(-> RGB
HSL)
- (let [red (..down (rgb.number (the rgb.#red it)))
- green (..down (rgb.number (the rgb.#green it)))
- blue (..down (rgb.number (the rgb.#blue it)))
+ (let [red (..down (rgb.red it))
+ green (..down (rgb.green it))
+ blue (..down (rgb.blue it))
max (all f.max red green blue)
min (all f.min red green blue)
@@ -160,18 +156,17 @@
(-> HSL
RGB)
(let [[hue saturation luminance] (nominal.representation it)]
- (try.trusted
- (if (f.= ..least saturation)
- ... Achromatic
- (let [intensity (..up luminance)]
- (rgb.rgb intensity intensity intensity))
- ... Chromatic
- (let [q (if (f.< +0.5 luminance)
- (|> saturation (f.+ +1.0) (f.* luminance))
- (|> luminance (f.+ saturation) (f.- (f.* saturation luminance))))
- p (|> luminance (f.* +2.0) (f.- q))
- third (|> +1.0 (f./ +3.0))]
- (rgb.rgb (|> hue (f.+ third) (hue_rgb p q))
- (|> hue (hue_rgb p q))
- (|> hue (f.- third) (hue_rgb p q))))))))
+ (if (f.= ..least saturation)
+ ... Achromatic
+ (let [intensity (..up luminance)]
+ (rgb.rgb intensity intensity intensity))
+ ... Chromatic
+ (let [q (if (f.< +0.5 luminance)
+ (|> saturation (f.+ +1.0) (f.* luminance))
+ (|> luminance (f.+ saturation) (f.- (f.* saturation luminance))))
+ p (|> luminance (f.* +2.0) (f.- q))
+ third (|> +1.0 (f./ +3.0))]
+ (rgb.rgb (|> hue (f.+ third) (hue_rgb p q))
+ (|> hue (hue_rgb p q))
+ (|> hue (f.- third) (hue_rgb p q)))))))
)
diff --git a/stdlib/source/library/lux/data/color/named.lux b/stdlib/source/library/lux/data/color/named.lux
index 29f58b285..90c603977 100644
--- a/stdlib/source/library/lux/data/color/named.lux
+++ b/stdlib/source/library/lux/data/color/named.lux
@@ -1,8 +1,6 @@
(.require
[library
[lux (.except)
- [control
- ["[0]" try]]
[math
[number (.only hex)]]]]
["[0]" // (.only Color)
@@ -15,7 +13,6 @@
(|> (rgb.rgb (hex <red>)
(hex <green>)
(hex <blue>))
- try.trusted
//.of_rgb)))]
["F0" "F8" "FF" alice_blue]
diff --git a/stdlib/source/library/lux/data/color/rgb.lux b/stdlib/source/library/lux/data/color/rgb.lux
index 8c14e7903..9f812baa9 100644
--- a/stdlib/source/library/lux/data/color/rgb.lux
+++ b/stdlib/source/library/lux/data/color/rgb.lux
@@ -7,11 +7,10 @@
[equivalence (.only Equivalence)]
["[0]" hash (.only Hash)]]
[control
- ["[0]" try (.only Try)]
- ["[0]" exception (.only Exception)]]
+ [function
+ [predicate (.only Predicate)]]]
[data
- [text
- ["%" \\format]]]
+ ["[0]" product]]
[math
[number
["n" nat]
@@ -24,101 +23,103 @@
Nat
256)
-(nominal.def .public Value
- Nat
-
- (def .public least
- Value
- (nominal.abstraction 0))
+(type .public Value
+ Nat)
- (def .public most
- Value
- (nominal.abstraction (-- ..limit)))
+(with_template [<name> <value>]
+ [(def .public <name>
+ Value
+ <value>)]
- (exception.def .public (invalid it)
- (Exception Nat)
- (exception.report
- (list ["Limit" (%.nat ..limit)]
- ["Value" (%.nat it)])))
+ [least 0]
+ [most (-- limit)]
+ )
- (def .public (value it)
- (-> Nat
- (Try Value))
- (if (n.< ..limit it)
- {try.#Success (nominal.abstraction it)}
- (exception.except ..invalid [it])))
+(def .public (value? it)
+ (Predicate Nat)
+ (not (or (n.< ..least it)
+ (n.> ..most it))))
- (def .public number
- (-> Value Nat)
- (|>> nominal.representation))
+(def .public value
+ (-> Nat
+ Value)
+ (|>> (n.max ..least)
+ (n.min ..most)))
- (type .public RGB
- (Record
- [#red Value
- #green Value
- #blue Value]))
+(nominal.def .public RGB
+ (Record
+ [#red Value
+ #green Value
+ #blue Value])
(def .public (rgb red green blue)
(-> Nat Nat Nat
- (Try RGB))
- (do try.monad
- [red (value red)
- green (value green)
- blue (value blue)]
- (in [#red red
- #green green
- #blue blue])))
-
- (def .public equivalence
- (Equivalence RGB)
- (implementation
- (def (= [rR gR bR] [rS gS bS])
- (and (n.= (nominal.representation rR) (nominal.representation rS))
- (n.= (nominal.representation gR) (nominal.representation gS))
- (n.= (nominal.representation bR) (nominal.representation bS))))))
+ RGB)
+ (nominal.abstraction
+ [#red (value red)
+ #green (value green)
+ #blue (value blue)]))
+
+ (with_template [<name> <slot>]
+ [(def .public <name>
+ (-> RGB
+ Value)
+ (|>> nominal.representation
+ (the <slot>)))]
+
+ [red #red]
+ [green #green]
+ [blue #blue]
+ )
(def .public hash
(Hash RGB)
- (implementation
- (def equivalence
- ..equivalence)
+ (of hash.functor each
+ (|>> nominal.representation)
+ (all product.hash
+ n.hash
+ n.hash
+ n.hash
+ )))
- (def (hash [r g b])
- (all i64.or
- (i64.left_shifted 16 (nominal.representation r))
- (i64.left_shifted 08 (nominal.representation g))
- (nominal.representation b)))))
+ (def .public equivalence
+ (Equivalence RGB)
+ (of ..hash equivalence))
(def (opposite_intensity value)
- (-> Nat Nat)
- (|> (nominal.representation ..most)
+ (-> Nat
+ Nat)
+ (|> ..most
(n.- value)))
(def .public (complement it)
- (-> RGB RGB)
- (`` [(,, (with_template [<slot>]
- [<slot> (|> it
- (the <slot>)
- nominal.representation
- opposite_intensity
- nominal.abstraction)]
-
- [#red]
- [#green]
- [#blue]
- ))]))
+ (-> RGB
+ RGB)
+ (nominal.abstraction
+ (`` [(,, (with_template [<slot>]
+ [<slot> (|> it
+ nominal.representation
+ (the <slot>)
+ opposite_intensity)]
+
+ [#red]
+ [#green]
+ [#blue]
+ ))])))
(def .public black
RGB
- [#red ..least
- #green ..least
- #blue ..least])
+ (nominal.abstraction
+ [#red ..least
+ #green ..least
+ #blue ..least]))
(def .public white
RGB
- [#red ..most
- #green ..most
- #blue ..most])
+ (nominal.abstraction
+ [#red ..most
+ #green ..most
+ #blue ..most]))
(with_template [<monoid> <identity> <composite> <left> <right>]
[(def .public <monoid>
@@ -130,15 +131,15 @@
(def (composite left right)
(let [left (<left> left)
right (<right> right)]
- (`` [(,, (with_template [<slot>]
- [<slot> (nominal.abstraction
- (<composite> (nominal.representation (the <slot> left))
- (nominal.representation (the <slot> right))))]
-
- [#red]
- [#green]
- [#blue]
- ))])))))]
+ (nominal.abstraction
+ (`` [(,, (with_template [<slot>]
+ [<slot> (<composite> (the <slot> (nominal.representation left))
+ (the <slot> (nominal.representation right)))]
+
+ [#red]
+ [#green]
+ [#blue]
+ ))]))))))]
[addition ..black n.max |> |>]
[subtraction ..white n.min ..complement |>]
diff --git a/stdlib/source/library/lux/data/color/terminal.lux b/stdlib/source/library/lux/data/color/terminal.lux
index d59f2986b..64cf6bb64 100644
--- a/stdlib/source/library/lux/data/color/terminal.lux
+++ b/stdlib/source/library/lux/data/color/terminal.lux
@@ -90,9 +90,9 @@
(let [it (//.rgb it)]
(|> [(%.format ..command
<command>
- ";" (%.nat (rgb.number (the rgb.#red it)))
- ";" (%.nat (rgb.number (the rgb.#green it)))
- ";" (%.nat (rgb.number (the rgb.#blue it)))
+ ";" (%.nat (rgb.red it))
+ ";" (%.nat (rgb.green it))
+ ";" (%.nat (rgb.blue it))
"m")
<reset>]
(nominal.abstraction Command))))]
diff --git a/stdlib/source/library/lux/data/format/css.lux b/stdlib/source/library/lux/web/css.lux
index 517dd9f53..517dd9f53 100644
--- a/stdlib/source/library/lux/data/format/css.lux
+++ b/stdlib/source/library/lux/web/css.lux
diff --git a/stdlib/source/library/lux/data/format/css/class.lux b/stdlib/source/library/lux/web/css/class.lux
index 46e980a47..46e980a47 100644
--- a/stdlib/source/library/lux/data/format/css/class.lux
+++ b/stdlib/source/library/lux/web/css/class.lux
diff --git a/stdlib/source/library/lux/data/format/css/font.lux b/stdlib/source/library/lux/web/css/font.lux
index f69a8f602..f69a8f602 100644
--- a/stdlib/source/library/lux/data/format/css/font.lux
+++ b/stdlib/source/library/lux/web/css/font.lux
diff --git a/stdlib/source/library/lux/data/format/css/id.lux b/stdlib/source/library/lux/web/css/id.lux
index fc93ec1bb..fc93ec1bb 100644
--- a/stdlib/source/library/lux/data/format/css/id.lux
+++ b/stdlib/source/library/lux/web/css/id.lux
diff --git a/stdlib/source/library/lux/data/format/css/property.lux b/stdlib/source/library/lux/web/css/property.lux
index 192f0395a..192f0395a 100644
--- a/stdlib/source/library/lux/data/format/css/property.lux
+++ b/stdlib/source/library/lux/web/css/property.lux
diff --git a/stdlib/source/library/lux/data/format/css/query.lux b/stdlib/source/library/lux/web/css/query.lux
index de3defe3b..de3defe3b 100644
--- a/stdlib/source/library/lux/data/format/css/query.lux
+++ b/stdlib/source/library/lux/web/css/query.lux
diff --git a/stdlib/source/library/lux/data/format/css/selector.lux b/stdlib/source/library/lux/web/css/selector.lux
index 292e27300..292e27300 100644
--- a/stdlib/source/library/lux/data/format/css/selector.lux
+++ b/stdlib/source/library/lux/web/css/selector.lux
diff --git a/stdlib/source/library/lux/data/format/css/style.lux b/stdlib/source/library/lux/web/css/style.lux
index d1bd1899d..d1bd1899d 100644
--- a/stdlib/source/library/lux/data/format/css/style.lux
+++ b/stdlib/source/library/lux/web/css/style.lux
diff --git a/stdlib/source/library/lux/data/format/css/value.lux b/stdlib/source/library/lux/web/css/value.lux
index 035d45c10..37c8580a0 100644
--- a/stdlib/source/library/lux/data/format/css/value.lux
+++ b/stdlib/source/library/lux/web/css/value.lux
@@ -832,19 +832,18 @@
(def .public (rgb color)
(-> color.Color
(Value Color))
- (let [[red green blue] (color.rgb color)]
- (..apply "rgb" (list (%.nat (rgb.number red))
- (%.nat (rgb.number green))
- (%.nat (rgb.number blue))))))
+ (let [color (color.rgb color)]
+ (..apply "rgb" (list (%.nat (rgb.red color))
+ (%.nat (rgb.green color))
+ (%.nat (rgb.blue color))))))
(def .public (rgba pigment)
(-> Pigment
(Value Color))
- (let [(open "/[0]") pigment
- [red green blue] /#color]
- (..apply "rgba" (list (%.nat (rgb.number red))
- (%.nat (rgb.number green))
- (%.nat (rgb.number blue))
+ (let [(open "/[0]") pigment]
+ (..apply "rgba" (list (%.nat (rgb.red /#color))
+ (%.nat (rgb.green /#color))
+ (%.nat (rgb.blue /#color))
(if (r.= (of r.interval top) /#alpha)
"1.0"
(format "0" (%.rev /#alpha)))))))
diff --git a/stdlib/source/library/lux/data/format/html.lux b/stdlib/source/library/lux/web/html.lux
index eb4569b48..a9191443c 100644
--- a/stdlib/source/library/lux/data/format/html.lux
+++ b/stdlib/source/library/lux/web/html.lux
@@ -9,7 +9,9 @@
["[0]" text (.only)
["%" \\format (.only Format format)]]
[collection
- ["[0]" list (.use "[1]#[0]" functor mix)]]]
+ ["[0]" list (.use "[1]#[0]" functor mix)]]
+ [format
+ ["[0]" xml (.only XML)]]]
[meta
[macro
["[0]" template]]
@@ -20,7 +22,6 @@
[world
[net (.only URL)]]]]
[//
- ["[0]" xml (.only XML)]
["[0]" css
["[0]" selector]
["[0]" style (.only Style)]
diff --git a/stdlib/source/library/lux/world/net/http/response.lux b/stdlib/source/library/lux/world/net/http/response.lux
index 1c8cef67c..93bd80ac8 100644
--- a/stdlib/source/library/lux/world/net/http/response.lux
+++ b/stdlib/source/library/lux/world/net/http/response.lux
@@ -13,9 +13,10 @@
[encoding
["[0]" utf8]]]
[format
- ["[0]" html]
- ["[0]" css (.only CSS)]
- ["[0]" json (.only JSON) (.use "[1]#[0]" codec)]]]]]
+ ["[0]" json (.only JSON) (.use "[1]#[0]" codec)]]]
+ [web
+ ["[0]" html]
+ ["[0]" css (.only CSS)]]]]
["[0]" // (.only Body Message)
["[0]" status (.only Status)]
["[0]" header]
diff --git a/stdlib/source/library/lux/world/time/series.lux b/stdlib/source/library/lux/world/time/series.lux
index c529f6636..debbe884a 100644
--- a/stdlib/source/library/lux/world/time/series.lux
+++ b/stdlib/source/library/lux/world/time/series.lux
@@ -4,121 +4,126 @@
[abstract
[equivalence (.only Equivalence)]
[functor (.only Functor)]
- [mix (.only Mix)]]
+ [mix (.only Mix)]
+ [monad (.only do)]]
[control
["[0]" try (.only Try)]
["[0]" exception (.only Exception)]]
[data
+ ["[0]" product]
[text
["%" \\format]]
[collection
- ["[0]" array (.only Array) (.use "[1]#[0]" functor mix)
- ["/" \\unsafe]]]]
+ ["/" sequence (.use "[1]#[0]" functor mix)]]]
+ [math
+ [number
+ ["n" nat]]]
[meta
- [type
- ["[0]" nominal]]]]]
+ [type (.only sharing)]]]]
[//
+ ["[0]" duration (.only Duration) (.use "[1]#[0]" equivalence)]
["[0]" instant (.only Instant) (.use "[1]#[0]" order)]])
-(type .public (Event of)
+(type .public (Series of)
(Record
- [#when Instant
- #what of]))
+ [#start Instant
+ #interval Duration
+ #data (/.Sequence of)]))
-(def (event_equivalence super)
+(def .public (equivalence super)
(All (_ of)
(-> (Equivalence of)
- (Equivalence (Event of))))
+ (Equivalence (Series of))))
+ (all product.equivalence
+ instant.equivalence
+ duration.equivalence
+ (/.equivalence super)
+ ))
+
+(def .public functor
+ (Functor Series)
(implementation
- (def (= reference example)
- (and (instant#= (the #when reference) (the #when example))
- (of super = (the #what reference) (the #what example))))))
+ (def (each $)
+ (|>> (revised #data (/#each $))))))
-(nominal.def .public (Series of)
- (Array (Event of))
+(def .public mix
+ (Mix Series)
+ (implementation
+ (def (mix $ init)
+ (|>> (the #data)
+ (/#mix $ init)))))
- (def .public (equivalence super)
- (All (_ of)
- (-> (Equivalence of)
- (Equivalence (Series of))))
- (implementation
- (def (= reference example)
- (of (array.equivalence (event_equivalence super)) =
- (nominal.representation reference)
- (nominal.representation example)))))
+(def .public size
+ (All (_ of)
+ (-> (Series of)
+ Nat))
+ (|>> (the #data)
+ /.size))
- (def .public functor
- (Functor Series)
- (implementation
- (def (each $)
- (|>> nominal.representation
- (array#each (revised #what $))
- nominal.abstraction))))
+(def .public start
+ (All (_ of)
+ (-> (Series of)
+ Instant))
+ (the #start))
- (def .public mix
- (Mix Series)
- (implementation
- (def (mix $ init)
- (|>> nominal.representation
- (array#mix (function (_ next it)
- ($ (the #what next) it))
- init)))))
+(def .public (end it)
+ (All (_ of)
+ (-> (Series of)
+ Instant))
+ (instant.after (duration.up (-- (/.size (the #data it)))
+ (the #interval it))
+ (the #start it)))
- (exception.def .public (disordered [before after])
- (Exception [Instant Instant])
- (exception.report
- (list ["(Expected) before" (%.instant before)]
- ["(Expected) after" (%.instant after)])))
+(def .public (at event it)
+ (All (_ of)
+ (-> Nat (Series of)
+ Instant))
+ (instant.after (duration.up event (the #interval it))
+ (the #start it)))
- (exception.def .public (duplicated it)
- (Exception Instant)
- (exception.report
- (list ["Time-stamp" (%.instant it)])))
+(exception.def .public empty)
- (def .public (series it)
- (All (_ of)
- (-> (List (Event of))
- (Try (Series of))))
- (when it
- {.#Item head tail}
- (loop (again [previous head
- it tail])
- (when it
- {.#Item current next}
- (if (instant#< (the #when current) (the #when previous))
- (again current next)
- (if (instant#= (the #when current) (the #when previous))
- (exception.except ..duplicated [(the #when current)])
- (exception.except ..disordered [(the #when previous) (the #when current)])))
-
- {.#End}
- {try.#Success (nominal.abstraction
- (array.of_list it))}))
-
- {.#End}
- {try.#Success (nominal.abstraction
- (array.empty 0))}))
+(with_template [<index> <name>]
+ [(def .public (<name> it)
+ (All (_ of)
+ (-> (Series of)
+ (Try of)))
+ (let [data (the #data it)]
+ (when (/.size data)
+ 0 (exception.except ..empty [])
+ @ (/.item <index> data))))]
- (def .public size
- (All (_ of)
- (-> (Series of)
- Nat))
- (|>> nominal.representation
- /.size))
+ [(|> 0) earliest]
+ [(-- @) latest]
+ )
- (exception.def .public empty)
-
- (with_template [<name> <index>]
- [(def .public (<name> it)
- (All (_ of)
- (-> (Series of)
- (Try (Event of))))
- (let [it (nominal.representation it)]
- (when (array.size it)
- 0 (exception.except ..empty [])
- @ {try.#Success (/.item <index> it)})))]
+(exception.def .public (window_goes_out_of_bounds [offset size max_size])
+ (Exception [Nat Nat Nat])
+ (exception.report
+ (list ["From" (%.nat offset)]
+ ["To" (%.nat (n.+ offset size))]
+ ["Maximum" (%.nat max_size)])))
- [earliest 0]
- [latest (-- @)]
- )
- )
+(def .public (window offset size it)
+ (All (_ of)
+ (-> Nat Nat (Series of)
+ (Try (Series of))))
+ (if (n.< (n.+ offset size)
+ (..size it))
+ (exception.except ..window_goes_out_of_bounds [offset size (..size it)])
+ (let [input (the #data it)]
+ (loop (again [item 0
+ output (sharing [of]
+ (is (/.Sequence of)
+ input)
+ (is (/.Sequence of)
+ /.empty))])
+ (if (n.< size item)
+ (do try.monad
+ [it (/.item (n.+ offset item) input)]
+ (again (++ item) (/.suffix it output)))
+ {try.#Success (let [interval (the #interval it)]
+ [#start (instant.after (duration.up offset interval)
+ (the #start it))
+ #interval interval
+ #data output])})))))
diff --git a/stdlib/source/library/lux/world/time/series/average.lux b/stdlib/source/library/lux/world/time/series/average.lux
new file mode 100644
index 000000000..553cfee7f
--- /dev/null
+++ b/stdlib/source/library/lux/world/time/series/average.lux
@@ -0,0 +1,129 @@
+(.require
+ [library
+ [lux (.except)
+ [abstract
+ [monad (.only do)]]
+ [control
+ ["[0]" try (.only Try)]
+ ["[0]" exception (.only Exception)]]
+ [data
+ ["[0]" product]
+ [text
+ ["%" \\format]]
+ [collection
+ ["[0]" sequence (.only Sequence) (.use "[1]#[0]" mix functor)]]]
+ [math
+ [number
+ ["n" nat]
+ ["f" frac]]]
+ [meta
+ [type (.only sharing)]]]]
+ ["[0]" // (.only Series) (.use "[1]#[0]" mix)])
+
+... https://en.wikipedia.org/wiki/Moving_average#Cumulative_average
+(def .public cumulative
+ (-> (Series Frac)
+ (Series Frac))
+ (revised //.#data
+ (|>> (sequence#mix (function (_ event [[previous_summation previous_period] output])
+ (let [summation (f.+ previous_summation event)
+ average (f./ previous_period summation)]
+ [[summation (f.+ +1.0 previous_period)]
+ (sequence.suffix average output)]))
+ [[+0.0 +1.0] (is (Sequence Frac)
+ sequence.empty)])
+ product.right)))
+
+(exception.def .public (window_size_is_too_large [maximum actual])
+ (Exception [Nat Nat])
+ (exception.report
+ (list ["Maximum" (%.nat maximum)]
+ ["Actual" (%.nat actual)])))
+
+(def .public (windows size it)
+ (All (_ of)
+ (-> Nat (Series of)
+ (Try (Series (Series of)))))
+ (let [maximum (//.size it)]
+ (if (n.< size maximum)
+ (exception.except ..window_size_is_too_large [maximum size])
+ (let [limit (n.- size maximum)]
+ (loop (again [offset 0
+ output (sharing [of]
+ (is (Series of)
+ it)
+ (is (Sequence (Series of))
+ sequence.empty))])
+ (if (n.< limit offset)
+ (do try.monad
+ [current (//.window offset size it)]
+ (again (++ offset)
+ (sequence.suffix current output)))
+ {try.#Success (has //.#data output it)}))))))
+
+(type .public (Average of)
+ (-> (Series of)
+ of))
+
+... https://en.wikipedia.org/wiki/Moving_average
+(def .public (moving average additional it)
+ (All (_ of)
+ (-> (Average of) Nat (Series of)
+ (Try (Series of))))
+ (do try.monad
+ [.let [size (++ additional)]
+ it (windows size it)]
+ (in (|> it
+ (revised //.#data (sequence#each average))
+ (has //.#start (//.at size it))))))
+
+... https://en.wikipedia.org/wiki/Moving_average#Exponential_moving_average
+... https://en.wikipedia.org/wiki/Exponential_smoothing
+(type .public Factor
+ (-> Nat
+ Frac))
+
+(def .public (simple_factor additional)
+ Factor
+ (f./ (n.frac (n.+ 2 additional))
+ +2.0))
+
+(def .public (exponential factor)
+ (-> Factor
+ (Average Frac))
+ (function (_ it)
+ (let [factor (factor (//.size it))
+ ~factor (f.- factor +1.0)]
+ (//#mix (is (-> Frac Frac
+ Frac)
+ (function (_ event previous)
+ (f.+ (f.* ~factor previous)
+ (f.* factor event))))
+ +0.0
+ it))))
+
+... https://en.wikipedia.org/wiki/Moving_average#Simple_moving_average
+(def .public (simple it)
+ (Average Frac)
+ (|> (the //.#data it)
+ (sequence#mix f.+ +0.0)
+ (f./ (n.frac (//.size it)))))
+
+... https://en.wikipedia.org/wiki/Triangular_number
+(def (summation_up_to maximum)
+ (-> Nat
+ Nat)
+ (|> maximum
+ (n.* (++ maximum))
+ (n./ 2)))
+
+... https://en.wikipedia.org/wiki/Moving_average#Weighted_moving_average
+(def .public (weighted it)
+ (Average Frac)
+ (|> it
+ (//#mix (function (_ sample [weight summation])
+ [(f.+ +1.0 weight)
+ (|> sample (f.* weight) (f.+ summation))])
+ [+1.0 +0.0])
+ product.right
+ (f./ (n.frac (summation_up_to (-- (//.size it)))))))
diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux
index 8a38c3a98..ad34204aa 100644
--- a/stdlib/source/test/lux/data/collection/sequence.lux
+++ b/stdlib/source/test/lux/data/collection/sequence.lux
@@ -134,7 +134,8 @@
(def .public test
Test
(<| (_.covering /._)
- (_.for [/.Sequence])
+ (_.for [/.Sequence
+ /.#level /.#size /.#root /.#tail])
(do [! random.monad]
[size (of ! each (|>> (n.% 100) ++) random.nat)]
(all _.and
@@ -194,6 +195,23 @@
(n.= (/.size sample)
(n.+ (/.size positives)
(/.size negatives))))))
+ (_.coverage [/.all]
+ (let [positives (/.all (function (_ it)
+ (if (n.even? it)
+ {.#Some it}
+ {.#None}))
+ sample)
+ negatives (/.all (function (_ it)
+ (if (not (n.even? it))
+ {.#Some it}
+ {.#None}))
+ sample)]
+ (and (/.every? n.even? positives)
+ (not (/.any? n.even? negatives))
+
+ (n.= (/.size sample)
+ (n.+ (/.size positives)
+ (/.size negatives))))))
(_.coverage [/.one]
(let [(open "/#[0]") /.functor
choice (is (-> Nat (Maybe Text))
diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux
index 5d94addef..c72ee2c1f 100644
--- a/stdlib/source/test/lux/data/color.lux
+++ b/stdlib/source/test/lux/data/color.lux
@@ -56,13 +56,13 @@
(def (distance/3 from to)
(-> /.Color /.Color Frac)
- (let [[fr fg fb] (/.rgb from)
- [tr tg tb] (/.rgb to)]
+ (let [from (/.rgb from)
+ to (/.rgb to)]
(square_root
(all f.+
- (|> (scale (rgb.number tr)) (f.- (scale (rgb.number fr))) square)
- (|> (scale (rgb.number tg)) (f.- (scale (rgb.number fg))) square)
- (|> (scale (rgb.number tb)) (f.- (scale (rgb.number fb))) square)))))
+ (|> (scale (rgb.red to)) (f.- (scale (rgb.red from))) square)
+ (|> (scale (rgb.green to)) (f.- (scale (rgb.green from))) square)
+ (|> (scale (rgb.blue to)) (f.- (scale (rgb.blue from))) square)))))
(def rgb_error_margin
+1.8)
diff --git a/stdlib/source/test/lux/data/color/pigment.lux b/stdlib/source/test/lux/data/color/pigment.lux
index b1798e438..d3ef54029 100644
--- a/stdlib/source/test/lux/data/color/pigment.lux
+++ b/stdlib/source/test/lux/data/color/pigment.lux
@@ -17,7 +17,8 @@
(<| (_.covering /._)
(do [! random.monad]
[alpha random.rev])
- (_.for [/.Alpha /.Pigment])
+ (_.for [/.Alpha /.Pigment
+ /.#color /.#alpha])
(all _.and
(_.coverage [/.transparent]
(and (not (r.< /.transparent alpha))
diff --git a/stdlib/source/test/lux/data/color/rgb.lux b/stdlib/source/test/lux/data/color/rgb.lux
index a1899e63c..5c81582eb 100644
--- a/stdlib/source/test/lux/data/color/rgb.lux
+++ b/stdlib/source/test/lux/data/color/rgb.lux
@@ -21,10 +21,8 @@
(def .public value
(Random /.Value)
- (random.one (|>> (n.% /.limit)
- /.value
- try.maybe)
- random.nat))
+ (random#each (|>> (n.% /.limit) /.value)
+ random.nat))
(def .public random
(Random /.RGB)
@@ -32,51 +30,42 @@
[red ..value
green ..value
blue ..value]
- (in [/.#red red
- /.#green green
- /.#blue blue])))
+ (in (/.rgb red green blue))))
(def .public test
Test
(<| (_.covering /._)
(do [! random.monad]
[expected_value ..value
- expected ..random])
+ expected ..random
+
+ expected_red ..value
+ expected_green ..value
+ expected_blue ..value])
(all _.and
(_.for [/.Value]
(all _.and
- (_.coverage [/.number /.value]
+ (_.coverage [/.least]
+ (n.>= /.least
+ expected_value))
+ (_.coverage [/.most]
+ (n.<= /.most
+ expected_value))
+ (_.coverage [/.value?]
+ (and (/.value? expected_value)
+ (not (/.value? (++ /.most)))
+ (not (/.value? (-- /.least)))))
+ (_.coverage [/.value]
(|> expected_value
- /.number
/.value
- (try#each (|>> /.number
- (n.= (/.number expected_value))))
- (try.else false)))
+ (n.= expected_value)))
(_.coverage [/.limit]
- (and (when (/.value /.limit)
- {try.#Failure _} true
- {try.#Success _} false)
- (when (/.value (-- /.limit))
- {try.#Failure _} false
- {try.#Success _} true)))
- (_.coverage [/.least]
- (when (/.value (++ (/.number /.least)))
- {try.#Failure _} false
- {try.#Success _} true))
- (_.coverage [/.most]
- (when (/.value (-- (/.number /.most)))
- {try.#Failure _} false
- {try.#Success _} true))
- (_.coverage [/.invalid]
- (and (when (/.value (-- (/.number /.least)))
- {try.#Failure it} (exception.match? /.invalid it)
- {try.#Success _} false)
- (when (/.value (++ (/.number /.most)))
- {try.#Failure it} (exception.match? /.invalid it)
- {try.#Success _} false)))
+ (|> /.limit
+ /.value
+ (n.= /.limit)
+ not))
))
- (_.for [/.RGB
- /.#red /.#green /.#blue]
+ (_.for [/.RGB]
(all _.and
(_.for [/.equivalence]
(equivalenceS.spec /.equivalence ..random))
@@ -87,36 +76,15 @@
(_.for [/.subtraction]
(monoidS.spec /.equivalence /.subtraction ..random))
- (_.coverage [/.rgb]
- (`` (and (let [red (/.number expected_value)
- green (/.number expected_value)
- blue (/.number expected_value)]
- (when (/.rgb red green blue)
- {try.#Failure _}
- false
-
- {try.#Success it}
- (and (n.= (/.number expected_value)
- (/.number (the /.#red it)))
- (n.= (/.number expected_value)
- (/.number (the /.#green it)))
- (n.= (/.number expected_value)
- (/.number (the /.#blue it))))))
- (,, (with_template [<red_offset> <green_offset> <blue_offset>]
- [(let [red (n.+ <red_offset> (/.number expected_value))
- green (n.+ <green_offset> (/.number expected_value))
- blue (n.+ <blue_offset> (/.number expected_value))]
- (when (/.rgb red green blue)
- {try.#Failure it}
- (exception.match? /.invalid it)
-
- {try.#Success _}
- false))]
-
- [/.limit 0 0]
- [0 /.limit 0]
- [0 0 /.limit]
- )))))
+ (_.coverage [/.rgb
+ /.red /.green /.blue]
+ (let [it (/.rgb expected_red expected_green expected_blue)]
+ (and (same? expected_red
+ (/.red it))
+ (same? expected_green
+ (/.green it))
+ (same? expected_blue
+ (/.blue it)))))
(_.coverage [/.complement]
(let [~expected (/.complement expected)
(open "/#[0]") /.equivalence]
diff --git a/stdlib/source/test/lux/world/net/http/response.lux b/stdlib/source/test/lux/world/net/http/response.lux
index 4e4e0baac..d25d3ce7f 100644
--- a/stdlib/source/test/lux/world/net/http/response.lux
+++ b/stdlib/source/test/lux/world/net/http/response.lux
@@ -17,17 +17,18 @@
[encoding
["[0]" utf8 (.use "[1]#[0]" codec)]]]
[format
- ["[0]" html]
- ["[0]" css (.only)
- ["[0]" selector]
- ["[0]" property]
- ["[0]" value]]
["[0]" json (.use "[1]#[0]" codec)
["[1]T" \\test]]]]
[math
["[0]" random (.only Random)]
[number
["n" nat]]]
+ [web
+ ["[0]" html]
+ ["[0]" css (.only)
+ ["[0]" selector]
+ ["[0]" property]
+ ["[0]" value]]]
[test
["_" property (.only Test)]
["[0]" unit]]]]
diff --git a/stdlib/source/test/lux/world/time/series.lux b/stdlib/source/test/lux/world/time/series.lux
index 806241c2b..47432df08 100644
--- a/stdlib/source/test/lux/world/time/series.lux
+++ b/stdlib/source/test/lux/world/time/series.lux
@@ -15,7 +15,8 @@
["[0]" product]
[collection
["[0]" list (.use "[1]#[0]" functor mix)]
- ["[0]" set]]]
+ ["[0]" set]
+ ["[0]" sequence]]]
[math
["[0]" random (.only Random) (.use "[1]#[0]" functor)]
[number
@@ -24,129 +25,123 @@
[world
[time
["[0]" instant (.only Instant) (.use "[1]#[0]" order)]
- ["[0]" duration]]]
+ ["[0]" duration (.only Duration)]]]
[test
["_" property (.only Test)]]]]
[\\library
- ["[0]" /]])
+ ["[0]" /]]
+ ["[0]" /
+ ["[1][0]" average]])
-(def .public (event it)
- (All (_ of)
- (-> (Random of)
- (Random (/.Event of))))
- (do random.monad
- [when random.instant
- what it]
- (in [/.#when when
- /.#what what])))
-
-(def .public (random size it)
+(def .public (random events it)
(All (_ of)
(-> Nat (Random of)
(Random (/.Series of))))
- (|> it
- (random.list size)
- (random#each (|>> (list#mix (function (_ what [when events])
- [(instant.before duration.milli_second when)
- (list.partial [/.#when when
- /.#what what]
- events)])
- [instant.latest (list)])
- product.right))
- (random.one (|>> /.series
- try.maybe))))
+ (do [! random.monad]
+ [.let [duration (random.only duration.positive? random.duration)]
+ offset (of ! each (duration.framed (duration.up 100 duration.normal_year))
+ duration)
+ .let [start (instant.after offset instant.epoch)]
+ interval (of ! each (duration.framed duration.week)
+ duration)
+ data (random.sequence events it)]
+ (in [/.#start start
+ /.#interval interval
+ /.#data data])))
-(def (injection when)
- (-> Instant
+(def (injection start interval)
+ (-> Instant Duration
(Injection /.Series))
- (|>> [/.#when when
- /.#what]
- list
- /.series
- try.trusted))
+ (|>> sequence.sequence
+ [/.#start start
+ /.#interval interval
+ /.#data]))
(def .public test
Test
(<| (_.covering /._)
(do [! random.monad]
- [before (..event random.nat)
- after (random.only (|>> (the /.#when)
- (instant#= (the /.#when before))
- not)
- (..event random.nat))
- .let [[before after] (if (instant#< (the /.#when after)
- (the /.#when before))
- [before after]
- [after before])]
+ [expected_size (of ! each (|>> (n.% 10) ++) random.nat)
+ expected_series (..random expected_size random.nat)
+
+ before random.nat
+ after random.nat
+ expected_start random.instant
+ expected_interval random.duration
- expected_instant random.instant
- expected_size (of ! each (n.% 10) random.nat)
- events (is (Random (List (/.Event Int)))
- (|> random.int
- (random.set i.hash expected_size)
- (of ! each (|>> set.list
- (list.sorted i.<)
- (list#each (function (_ it)
- [/.#when (instant.of_millis it)
- /.#what it]))))))])
- (all _.and
- (<| (_.for [/.Event
- /.#what /.#when])
- (`` (all _.and
- (,, (with_template [<event> <expected>]
- [(_.coverage [<event>]
- (|> (do try.monad
- [it (/.series (list before after))
- actual (<event> it)]
- (in (same? <expected> actual)))
- (try.else false)))]
+ window_size (of ! each (|>> (n.% expected_size) ++) random.nat)
+ window_offset (of ! each (n.% (++ (n.- window_size expected_size))) random.nat)])
+ (_.for [/.Series
+ /.#start /.#interval /.#data])
+ (`` (all _.and
+ (_.for [/.equivalence]
+ (equivalenceS.spec (/.equivalence n.equivalence) (..random expected_size random.nat)))
+ (_.for [/.mix]
+ (mixS.spec (..injection expected_start expected_interval) /.equivalence /.mix))
+ (_.for [/.functor]
+ (functorS.spec (..injection expected_start expected_interval) /.equivalence /.functor))
+
+ (_.coverage [/.size]
+ (n.= expected_size
+ (/.size expected_series)))
+ (_.coverage [/.start /.end]
+ (instant#< (/.end expected_series)
+ (/.start expected_series)))
+ (_.coverage [/.at]
+ (and (instant#= (/.at 0 expected_series)
+ (/.start expected_series))
+ (instant#< (/.at (-- expected_size) expected_series)
+ (/.start expected_series))))
+ (,, (with_template [<event> <expected>]
+ [(_.coverage [<event>]
+ (|> (do try.monad
+ [.let [it [/.#start expected_start
+ /.#interval expected_interval
+ /.#data (sequence.sequence before after)]]
+ actual (<event> it)]
+ (in (same? <expected> actual)))
+ (try.else false)))]
- [/.earliest before]
- [/.latest after]
- ))
- )))
- (<| (_.for [/.Series])
- (`` (all _.and
- (_.for [/.equivalence]
- (equivalenceS.spec (/.equivalence n.equivalence) (..random expected_size random.nat)))
- (_.for [/.mix]
- (mixS.spec (..injection expected_instant) /.equivalence /.mix))
- (_.for [/.functor]
- (functorS.spec (..injection expected_instant) /.equivalence /.functor))
-
- (_.coverage [/.series /.size]
- (|> (do try.monad
- [it (/.series events)]
- (in (/.size it)))
- (try#each (n.= expected_size))
- (try.else false)))
- (_.coverage [/.empty]
- (and (,, (with_template [<event> <expected>]
- [(|> (do try.monad
- [it (/.series (list))]
- (<event> it))
- (|.when
- {try.#Failure error}
- (exception.match? /.empty error)
-
- _
- false))]
+ [/.earliest before]
+ [/.latest after]
+ ))
+ (_.coverage [/.empty]
+ (and (,, (with_template [<event> <expected>]
+ [(|> (do try.monad
+ [.let [it [/.#start expected_start
+ /.#interval expected_interval
+ /.#data (sequence.sequence)]]]
+ (<event> it))
+ (|.when
+ {try.#Failure error}
+ (exception.match? /.empty error)
+
+ _
+ false))]
- [/.earliest before]
- [/.latest after]
- ))))
- (,, (with_template [<exception> <left> <right>]
- [(_.coverage [<exception>]
- (|> (/.series (list <left> <right>))
- (|.when
- {try.#Failure error}
- (exception.match? <exception> error)
-
- _
- false)))]
+ [/.earliest before]
+ [/.latest after]
+ ))))
+ (_.coverage [/.window]
+ (|> (do try.monad
+ [it (/.window window_offset window_size expected_series)]
+ (in (n.= window_size (/.size it))))
+ (try.else false)))
+ (_.coverage [/.window_goes_out_of_bounds]
+ (and (|> (/.window expected_size window_size expected_series)
+ (|.when
+ {try.#Failure error}
+ (exception.match? /.window_goes_out_of_bounds error)
+
+ _
+ false))
+ (|> (/.window (++ window_offset) expected_size expected_series)
+ (|.when
+ {try.#Failure error}
+ (exception.match? /.window_goes_out_of_bounds error)
+
+ _
+ false))))
- [/.disordered after before]
- [/.duplicated before before]
- ))
- )))
- )))
+ /average.test
+ ))))
diff --git a/stdlib/source/test/lux/world/time/series/average.lux b/stdlib/source/test/lux/world/time/series/average.lux
new file mode 100644
index 000000000..5cd02181a
--- /dev/null
+++ b/stdlib/source/test/lux/world/time/series/average.lux
@@ -0,0 +1,100 @@
+(.require
+ [library
+ [lux (.except)
+ [abstract
+ [monad (.only do)]]
+ [control
+ ["[0]" try]
+ ["[0]" exception]]
+ [math
+ ["[0]" random (.only Random)]
+ [number
+ ["n" nat]]]
+ [world
+ [time
+ ["[0]" instant (.use "[1]#[0]" order)]
+ ["[0]" duration (.use "[1]#[0]" equivalence)]]]
+ [test
+ ["_" property (.only Test)]]]]
+ [\\library
+ ["[0]" / (.only)
+ ["/[1]" //]]])
+
+(def (series events)
+ (-> Nat
+ (Random (/.Series Frac)))
+ (do [! random.monad]
+ [.let [duration (random.only duration.positive? random.duration)]
+ offset (of ! each (duration.framed (duration.up 100 duration.normal_year))
+ duration)
+ .let [start (instant.after offset instant.epoch)]
+ interval (of ! each (duration.framed duration.week)
+ duration)
+ data (random.sequence events random.safe_frac)]
+ (in [//.#start start
+ //.#interval interval
+ //.#data data])))
+
+(def .public test
+ Test
+ (<| (_.covering /._)
+ (do [! random.monad]
+ [expected_events (of ! each (|>> (n.% 10) ++) random.nat)
+ input (series expected_events)
+ expected_window_extras (of ! each (n.% expected_events) random.nat)])
+ (all _.and
+ (_.coverage [/.cumulative]
+ (let [output (/.cumulative input)]
+ (and (instant#= (//.start input)
+ (//.start output))
+ (n.= (//.size input)
+ (//.size output)))))
+ (_.coverage [/.windows]
+ (<| (try.else false)
+ (do try.monad
+ [output (/.windows expected_window_extras input)]
+ (in (and (instant#= (//.start input)
+ (//.start output))
+ (n.= (n./ (++ expected_window_extras) (//.size input))
+ (//.size output)))))))
+ (_.coverage [/.window_size_is_too_large]
+ (when (/.windows (++ expected_events) input)
+ {try.#Failure error}
+ (exception.match? /.window_size_is_too_large error)
+
+ {try.#Success _}
+ false))
+ (<| (_.for [/.Average /.moving])
+ (all _.and
+ (_.coverage [/.Factor /.simple_factor /.exponential]
+ (<| (try.else false)
+ (do try.monad
+ [output (/.moving (/.exponential /.simple_factor)
+ expected_window_extras
+ input)]
+ (in (and (instant#< (//.start output)
+ (//.start input))
+ (n.= (n.- expected_window_extras (//.size input))
+ (//.size output)))))))
+ (_.coverage [/.simple]
+ (<| (try.else false)
+ (do try.monad
+ [output (/.moving /.simple
+ expected_window_extras
+ input)]
+ (in (and (instant#< (//.start output)
+ (//.start input))
+ (n.= (n.- expected_window_extras (//.size input))
+ (//.size output)))))))
+ (_.coverage [/.weighted]
+ (<| (try.else false)
+ (do try.monad
+ [output (/.moving /.weighted
+ expected_window_extras
+ input)]
+ (in (and (instant#< (//.start output)
+ (//.start input))
+ (n.= (n.- expected_window_extras (//.size input))
+ (//.size output)))))))
+ ))
+ )))