From fd3f02c024687bc5c2b9741f6386719a0affb7bb Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 9 Dec 2022 17:18:41 -0400 Subject: Added machinery for averaging a time-series. --- .../source/test/lux/data/collection/sequence.lux | 20 +- stdlib/source/test/lux/data/color.lux | 10 +- stdlib/source/test/lux/data/color/pigment.lux | 3 +- stdlib/source/test/lux/data/color/rgb.lux | 100 ++++------ stdlib/source/test/lux/world/net/http/response.lux | 11 +- stdlib/source/test/lux/world/time/series.lux | 213 ++++++++++----------- .../source/test/lux/world/time/series/average.lux | 100 ++++++++++ 7 files changed, 270 insertions(+), 187 deletions(-) create mode 100644 stdlib/source/test/lux/world/time/series/average.lux (limited to 'stdlib/source/test') 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 @@ -191,6 +192,23 @@ (and (/.every? n.even? positives) (not (/.any? n.even? negatives)) + (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)))))) 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 [ ] - [(let [red (n.+ (/.number expected_value)) - green (n.+ (/.number expected_value)) - blue (n.+ (/.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 [ ] - [(_.coverage [] - (|> (do try.monad - [it (/.series (list before after)) - actual ( it)] - (in (same? 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 [ ] + [(_.coverage [] + (|> (do try.monad + [.let [it [/.#start expected_start + /.#interval expected_interval + /.#data (sequence.sequence before after)]] + actual ( it)] + (in (same? 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 [ ] - [(|> (do try.monad - [it (/.series (list))] - ( it)) - (|.when - {try.#Failure error} - (exception.match? /.empty error) - - _ - false))] + [/.earliest before] + [/.latest after] + )) + (_.coverage [/.empty] + (and (,, (with_template [ ] + [(|> (do try.monad + [.let [it [/.#start expected_start + /.#interval expected_interval + /.#data (sequence.sequence)]]] + ( it)) + (|.when + {try.#Failure error} + (exception.match? /.empty error) + + _ + false))] - [/.earliest before] - [/.latest after] - )))) - (,, (with_template [ ] - [(_.coverage [] - (|> (/.series (list )) - (|.when - {try.#Failure error} - (exception.match? 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))))))) + )) + ))) -- cgit v1.2.3