diff options
Diffstat (limited to 'stdlib/source')
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))))))) + )) + ))) |