Added trade session (OHLCV) abstraction.

9 files changed, 213 insertions, 148 deletions

diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux
index d1c9ba933..410580860 100644
--- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux
+++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux
@@ -42,7 +42,8 @@
 (def .public test
   Test
   (<| (_.covering /._)
-      (_.for [/.Dictionary])
+      (_.for [/.Dictionary
+              /.#order /.#root])
       (do [! random.monad]
         [size (of ! each (n.% 100) random.nat)
          keys (random.set n.hash size random.nat)
diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux
index ee2eb70b2..25c041fd7 100644
--- a/stdlib/source/test/lux/data/color.lux
+++ b/stdlib/source/test/lux/data/color.lux
@@ -36,68 +36,6 @@
   (Random /.Color)
   (random#each /.of_rgb /rgb.random))
 
-(def scale
-  (-> Nat Frac)
-  (|>> .int int.frac))
-
-(def square
-  (-> Frac Frac)
-  (f.pow +2.0))
-
-(def square_root
-  (-> Frac Frac)
-  (f.pow +0.5))
-
-(def (distance/3 from to)
-  (-> /.Color /.Color Frac)
-  (let [from (/.rgb from)
-        to (/.rgb to)]
-    (square_root
-     (all f.+
-          (|> (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)
-
-(with_template [<name> <field>]
-  [(def <name>
-     (-> /.Color Frac)
-     (|>> /.rgb
-          hsl.of_rgb
-          <field>))]
-
-  [saturation hsl.saturation]
-  [luminance hsl.luminance]
-  )
-
-... (def transformation
-...   Test
-...   (do random.monad
-...     [mediocre (|> ..random
-...                   (random.only (|>> saturation
-...                                     ((function (_ saturation)
-...                                        (and (f.>= +0.25 saturation)
-...                                             (f.<= +0.75 saturation)))))))
-...      ratio (|> random.safe_frac (random.only (f.>= +0.5)))]
-...     (all _.and
-...          (_.coverage [/.saturated]
-...            (f.> (saturation mediocre)
-...                 (saturation (/.saturated ratio mediocre))))
-...          (_.coverage [/.un_saturated]
-...            (f.< (saturation mediocre)
-...                 (saturation (/.un_saturated ratio mediocre))))
-...          (_.coverage [/.gray_scale]
-...            (let [gray'ed (/.gray_scale mediocre)]
-...              (and (f.= +0.0
-...                        (saturation gray'ed))
-...                   (|> (luminance gray'ed)
-...                       (f.- (luminance mediocre))
-...                       f.abs
-...                       (f.<= ..rgb_error_margin)))))
-...          )))
-
 ... (def palette
 ...   Test
 ...   (_.for [/.Spread /.Palette]
@@ -123,28 +61,6 @@
 ...                           [+1.0 /.analogous]
 ...                           [+0.5 /.monochromatic]
 ...                           ))
-...                     (,, (with_template [<palette>]
-...                           [(_.coverage [<palette>]
-...                              (let [expected (/.of_hsb [eH eS +0.5])
-...                                    [c0 c1 c2] (<palette> expected)]
-...                                (and (of /.equivalence = expected c0)
-...                                     (not (of /.equivalence = expected c1))
-...                                     (not (of /.equivalence = expected c2)))))]
-
-...                           [/.triad]
-...                           [/.clash]
-...                           [/.split_complement]))
-...                     (,, (with_template [<palette>]
-...                           [(_.coverage [<palette>]
-...                              (let [expected (/.of_hsb [eH eS +0.5])
-...                                    [c0 c1 c2 c3] (<palette> expected)]
-...                                (and (of /.equivalence = expected c0)
-...                                     (not (of /.equivalence = expected c1))
-...                                     (not (of /.equivalence = expected c2))
-...                                     (not (of /.equivalence = expected c3)))))]
-
-...                           [/.square]
-...                           [/.tetradic]))
 ...                     )))))
 
 (def .public test
@@ -154,7 +70,6 @@
       (do [! random.monad]
         [expected ..random]
         (all _.and
-             ... ..transformation
              ... ..palette
 
              /rgb.test
diff --git a/stdlib/source/test/lux/data/color/hsl.lux b/stdlib/source/test/lux/data/color/hsl.lux
index 72782e0f2..de9c3ef8a 100644
--- a/stdlib/source/test/lux/data/color/hsl.lux
+++ b/stdlib/source/test/lux/data/color/hsl.lux
@@ -14,7 +14,8 @@
  [\\library
   ["[0]" / (.only)
    [//
-    ["[0]" rgb]]]]
+    ["[0]" rgb]
+    ["[0]" hsb]]]]
  [//
   ["[0]T" rgb]])
 
@@ -30,6 +31,9 @@
      luminance ..value]
     (in (/.hsl hue saturation luminance))))
 
+(def rgb_error_margin
+  +1.8)
+
 (def .public test
   Test
   (<| (_.covering /._)
@@ -38,7 +42,18 @@
          expected_rgb rgbT.random
          expected_hsl ..random
 
-         possible_value random.frac])
+         possible_value random.frac
+
+         mediocre (|> ..random
+                      (random.only (|>> (the /.#saturation)
+                                        ((function (_ it)
+                                           (and (f.>= +0.25 it)
+                                                (f.<= +0.75 it)))))))
+         ratio (|> random.safe_frac (random.only (f.>= +0.5)))
+
+         eH (of ! each (|>> f.abs (f.% +0.9) (f.+ +0.05))
+                random.safe_frac)
+         .let [eS +0.5]])
       (all _.and
            (_.for [/.Value]
                   (all _.and
@@ -66,23 +81,63 @@
                               (/.value? (f.- f.smallest /.most))
                               (not (/.value? (f.+ f.smallest /.most)))))
                        ))
-           (_.for [/.HSL]
-                  (all _.and
-                       (_.for [/.equivalence]
-                              (equivalenceS.spec /.equivalence ..random))
+           (_.for [/.HSL
+                   /.#hue /.#saturation /.#luminance]
+                  (`` (all _.and
+                           (_.for [/.equivalence]
+                                  (equivalenceS.spec /.equivalence ..random))
 
-                       (_.coverage [/.hsl
-                                    /.hue /.saturation /.luminance]
-                         (|> (/.hsl (/.hue expected_hsl) (/.saturation expected_hsl) (/.luminance expected_hsl))
-                             (of /.equivalence = expected_hsl)))
-                       (_.coverage [/.of_rgb /.rgb]
-                         (and (|> expected_rgb
-                                  /.of_rgb
-                                  /.rgb
-                                  (of rgb.equivalence = expected_rgb))
-                              (|> expected_hsl
-                                  /.rgb
-                                  /.of_rgb
-                                  (of /.equivalence = expected_hsl))))
-                       ))
+                           (_.coverage [/.hsl]
+                             (|> (/.hsl (the /.#hue expected_hsl)
+                                        (the /.#saturation expected_hsl)
+                                        (the /.#luminance expected_hsl))
+                                 (of /.equivalence = expected_hsl)))
+                           (_.coverage [/.of_rgb /.rgb]
+                             (and (|> expected_rgb
+                                      /.of_rgb
+                                      /.rgb
+                                      (of rgb.equivalence = expected_rgb))
+                                  (|> expected_hsl
+                                      /.rgb
+                                      /.of_rgb
+                                      (of /.equivalence = expected_hsl))))
+
+                           (_.coverage [/.saturated]
+                             (f.> (the /.#saturation mediocre)
+                                  (the /.#saturation (/.saturated ratio mediocre))))
+                           (_.coverage [/.un_saturated]
+                             (f.< (the /.#saturation mediocre)
+                                  (the /.#saturation (/.un_saturated ratio mediocre))))
+                           (_.coverage [/.gray_scale]
+                             (let [gray'ed (/.gray_scale mediocre)]
+                               (and (f.= +0.0
+                                         (the /.#saturation gray'ed))
+                                    (|> (the /.#luminance gray'ed)
+                                        (f.- (the /.#luminance mediocre))
+                                        f.abs
+                                        (f.<= ..rgb_error_margin)))))
+
+                           (,, (with_template [<palette>]
+                                 [(_.coverage [<palette>]
+                                    (let [expected (/.of_rgb (hsb.rgb (hsb.hsb eH eS +0.5)))
+                                          [c0 c1 c2] (<palette> expected)]
+                                      (and (of /.equivalence = expected c0)
+                                           (not (of /.equivalence = expected c1))
+                                           (not (of /.equivalence = expected c2)))))]
+
+                                 [/.triad]
+                                 [/.clash]
+                                 [/.split_complement]))
+                           (,, (with_template [<palette>]
+                                 [(_.coverage [<palette>]
+                                    (let [expected (/.of_rgb (hsb.rgb (hsb.hsb eH eS +0.5)))
+                                          [c0 c1 c2 c3] (<palette> expected)]
+                                      (and (of /.equivalence = expected c0)
+                                           (not (of /.equivalence = expected c1))
+                                           (not (of /.equivalence = expected c2))
+                                           (not (of /.equivalence = expected c3)))))]
+
+                                 [/.square]
+                                 [/.tetradic]))
+                           )))
            )))
diff --git a/stdlib/source/test/lux/data/color/rgb.lux b/stdlib/source/test/lux/data/color/rgb.lux
index 19094bfe2..4325eb72b 100644
--- a/stdlib/source/test/lux/data/color/rgb.lux
+++ b/stdlib/source/test/lux/data/color/rgb.lux
@@ -55,9 +55,9 @@
       Frac)
   (square_root
    (all f.+
-        (|> (scale (/.red to)) (f.- (scale (/.red from))) square)
-        (|> (scale (/.green to)) (f.- (scale (/.green from))) square)
-        (|> (scale (/.blue to)) (f.- (scale (/.blue from))) square))))
+        (|> (scale (the /.#red to)) (f.- (scale (the /.#red from))) square)
+        (|> (scale (the /.#green to)) (f.- (scale (the /.#green from))) square)
+        (|> (scale (the /.#blue to)) (f.- (scale (the /.#blue from))) square))))
 
 (def .public test
   Test
@@ -99,7 +99,8 @@
                              (n.= /.limit)
                              not))
                        ))
-           (_.for [/.RGB]
+           (_.for [/.RGB
+                   /.#red /.#green /.#blue]
                   (all _.and
                        (_.for [/.equivalence]
                               (equivalenceS.spec /.equivalence ..random))
@@ -110,15 +111,14 @@
                        (_.for [/.subtraction]
                               (monoidS.spec /.equivalence /.subtraction ..random))
 
-                       (_.coverage [/.rgb
-                                    /.red /.green /.blue]
+                       (_.coverage [/.rgb]
                          (let [it (/.rgb expected_red expected_green expected_blue)]
                            (and (same? expected_red
-                                       (/.red it))
+                                       (the /.#red it))
                                 (same? expected_green
-                                       (/.green it))
+                                       (the /.#green it))
                                 (same? expected_blue
-                                       (/.blue it)))))
+                                       (the /.#blue it)))))
                        (_.coverage [/.complement]
                          (let [~expected (/.complement expected)
                                (open "/#[0]") /.equivalence]
diff --git a/stdlib/source/test/lux/meta/extension.lux b/stdlib/source/test/lux/meta/extension.lux
index 9d49aeb16..f98359d94 100644
--- a/stdlib/source/test/lux/meta/extension.lux
+++ b/stdlib/source/test/lux/meta/extension.lux
@@ -39,12 +39,12 @@
                                                ["[0]" name]]]))
                           (.,, (.these))))]
               [compiler
-               ["[0]" phase]
                [meta
                 [archive
                  ["[0]" unit]]]
                [language
                 [lux
+                 ["[0]" phase]
                  ["[0]" translation]
                  ["[0]" declaration]
                  ["[0]" analysis (.only)
diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux
index e1309f5f5..bf9ff3c7f 100644
--- a/stdlib/source/test/lux/world.lux
+++ b/stdlib/source/test/lux/world.lux
@@ -13,7 +13,10 @@
   ["[1][0]" output
    ["[1]/[0]" video
     ["[1]/[0]" resolution]]]
-  ["[1][0]" money]
+  ["[1][0]" finance
+   ["[1]/[0]" money]
+   ["[1]/[0]" trade
+    ["[1]/[0]" session]]]
   ["[1][0]" net]
   ["[1][0]" time]
   ["[1][0]" locale]
@@ -26,9 +29,13 @@
        /shell.test
        /console.test
        /environment.test
+       
        /input/keyboard.test
        /output/video/resolution.test
-       /money.test
+
+       /finance/money.test
+       /finance/trade/session.test
+
        /net.test
        /time.test
        /locale.test
diff --git a/stdlib/source/test/lux/world/money.lux b/stdlib/source/test/lux/world/finance/money.lux
index 4cddc38ee..773589a15 100644
--- a/stdlib/source/test/lux/world/money.lux
+++ b/stdlib/source/test/lux/world/finance/money.lux
@@ -13,48 +13,46 @@
     ["[0]" text (.only)
      ["%" \\format]]]
    [math
-    ["[0]" random (.only Random)]
+    ["[0]" random (.only Random) (.use "[1]#[0]" functor)]
     [number
      ["n" nat]]]
    [test
     ["_" property (.only Test)]]]]
  [\\library
   ["[0]" / (.only)
-   ["[0]" currency]]]
+   ["[0]" currency (.only Currency)]]]
  ["[0]" /
   ["[1][0]" currency]])
 
-(def .public random
-  (Random (Ex (_ of)
-            (/.Money of)))
-  (do random.monad
-    [expected_currency /currency.random
-     expected_amount random.nat]
-    (in (/.money expected_currency expected_amount))))
+(def .public (random $)
+  (All (_ $)
+    (-> (Currency $)
+        (Random (/.Money $))))
+  (random#each (/.money $)
+               random.nat))
 
 (def .public test
   Test
   (<| (_.covering /._)
       (do [! random.monad]
-        [.let [expected_currency currency.usd]
-         expected_amount random.nat
+        [expected_amount random.nat
 
          expected_parameter (random.only (n.> 0) random.nat)
          expected_subject random.nat])
       (_.for [/.Money])
       (all _.and
            (_.for [/.equivalence /.=]
-                  (equivalenceS.spec /.equivalence ..random))
+                  (equivalenceS.spec /.equivalence (..random currency.usd)))
            (_.for [/.order /.<]
-                  (orderS.spec /.order ..random))
+                  (orderS.spec /.order (..random currency.usd)))
            
            (_.coverage [/.money /.currency /.amount]
-             (let [it (/.money expected_currency expected_amount)]
-               (and (same? expected_currency (/.currency it))
+             (let [it (/.money currency.usd expected_amount)]
+               (and (same? currency.usd (/.currency it))
                     (same? expected_amount (/.amount it)))))
            (_.coverage [/.+ /.-]
-             (let [parameter (/.money expected_currency expected_parameter)
-                   subject (/.money expected_currency expected_subject)]
+             (let [parameter (/.money currency.usd expected_parameter)
+                   subject (/.money currency.usd expected_subject)]
                (and (|> subject
                         (/.+ parameter)
                         (of /.equivalence = subject)
@@ -65,21 +63,21 @@
                         (maybe#each (of /.equivalence = subject))
                         (maybe.else false)))))
            (_.coverage [/.min]
-             (let [expected_parameter (/.money expected_currency expected_parameter)
-                   expected_subject (/.money expected_currency expected_subject)]
+             (let [expected_parameter (/.money currency.usd expected_parameter)
+                   expected_subject (/.money currency.usd expected_subject)]
                (and (/.<= expected_parameter
                           (/.min expected_parameter expected_subject))
                     (/.<= expected_subject
                           (/.min expected_parameter expected_subject)))))
            (_.coverage [/.max]
-             (let [expected_parameter (/.money expected_currency expected_parameter)
-                   expected_subject (/.money expected_currency expected_subject)]
+             (let [expected_parameter (/.money currency.usd expected_parameter)
+                   expected_subject (/.money currency.usd expected_subject)]
                (and (/.>= expected_parameter
                           (/.max expected_parameter expected_subject))
                     (/.>= expected_subject
                           (/.max expected_parameter expected_subject)))))
-           (let [expected_parameter (/.money expected_currency expected_parameter)
-                 expected_subject (/.money expected_currency expected_subject)]
+           (let [expected_parameter (/.money currency.usd expected_parameter)
+                 expected_subject (/.money currency.usd expected_subject)]
              (all _.and
                   (_.coverage [/.>]
                     (bit#= (/.> expected_parameter expected_subject)
@@ -89,17 +87,17 @@
                            (/.>= expected_subject expected_parameter)))
                   ))
            (_.coverage [/.units /.sub_units]
-             (let [expected (/.money expected_currency expected_amount)
-                   actual (/.money expected_currency (n.+ (/.units expected)
-                                                          (/.sub_units expected)))]
+             (let [expected (/.money currency.usd expected_amount)
+                   actual (/.money currency.usd (n.+ (/.units expected)
+                                                     (/.sub_units expected)))]
                (/.= expected actual)))
            (_.coverage [/.of_units /.of_sub_units]
-             (let [expected (/.money expected_currency expected_amount)
-                   actual (/.+ (/.of_units expected_currency (/.units expected))
-                               (/.of_sub_units expected_currency (/.sub_units expected)))]
+             (let [expected (/.money currency.usd expected_amount)
+                   actual (/.+ (/.of_units currency.usd (/.units expected))
+                               (/.of_sub_units currency.usd (/.sub_units expected)))]
                (/.= expected actual)))
            (do !
-             [it ..random]
+             [it (..random currency.usd)]
              (_.coverage [/.format]
                (and (text.starts_with? (%.nat (/.amount it))
                                        (text.replaced_once "." "" (/.format it)))
diff --git a/stdlib/source/test/lux/world/money/currency.lux b/stdlib/source/test/lux/world/finance/money/currency.lux
index eeb59e9fc..eeb59e9fc 100644
--- a/stdlib/source/test/lux/world/money/currency.lux
+++ b/stdlib/source/test/lux/world/finance/money/currency.lux
diff --git a/stdlib/source/test/lux/world/finance/trade/session.lux b/stdlib/source/test/lux/world/finance/trade/session.lux
new file mode 100644
index 000000000..6ce1979d2
--- /dev/null
+++ b/stdlib/source/test/lux/world/finance/trade/session.lux
@@ -0,0 +1,89 @@
+(.require
+ [library
+  [lux (.except)
+   [abstract
+    [monad (.only do)]
+    [\\specification
+     ["[0]S" equivalence]]]
+   [data
+    ["[0]" bit (.use "[1]#[0]" equivalence)]
+    ["[0]" text (.use "[1]#[0]" equivalence)]
+    [collection
+     ["[0]" list]]]
+   [math
+    ["[0]" random (.only Random)]
+    [number
+     ["n" nat]]]
+   [test
+    ["_" property (.only Test)]]]]
+ [\\library
+  ["[0]" / (.only)
+   [///
+    ["[0]" money (.only)
+     ["[0]" currency (.only Currency)]]]]]
+ [///
+  ["[0]T" money]])
+
+(def .public (random $)
+  (All (_ $)
+    (-> (Currency $)
+        (Random (/.Session $))))
+  (do random.monad
+    [p0 (moneyT.random $)
+     p1 (moneyT.random $)
+     p2 (moneyT.random $)
+     p3 (moneyT.random $)
+     bullish? random.bit
+     volume random.nat]
+    (when (list.sorted money.< (list p0 p1 p2 p3))
+      (list low bottom top high)
+      (in [/.#open (if bullish?
+                     bottom
+                     top)
+           /.#high high
+           /.#low low
+           /.#close (if bullish?
+                      top
+                      bottom)
+           /.#volume volume])
+
+      _
+      (undefined))))
+
+(def .public test
+  Test
+  (<| (_.covering /._)
+      (do [! random.monad]
+        [before (..random currency.usd)
+         after (..random currency.usd)])
+      (_.for [/.Session /.Price /.Volume
+              /.#open /.#high /.#low /.#close /.#volume])
+      (all _.and
+           (_.for [/.equivalence]
+                  (equivalenceS.spec /.equivalence (..random currency.usd)))
+           
+           (_.coverage [/.composite]
+             (let [both (/.composite before after)]
+               (and (money.= (the /.#open before)
+                             (the /.#open both))
+                    (and (money.>= (the /.#high before)
+                                   (the /.#high both))
+                         (money.>= (the /.#high after)
+                                   (the /.#high both)))
+                    (and (money.<= (the /.#low before)
+                                   (the /.#low both))
+                         (money.<= (the /.#low after)
+                                   (the /.#low both)))
+                    (money.= (the /.#close after)
+                             (the /.#close both))
+                    (and (n.>= (the /.#volume before)
+                               (the /.#volume both))
+                         (n.>= (the /.#volume after)
+                               (the /.#volume both))))))
+           (_.coverage [/.format]
+             (bit#= (of /.equivalence =
+                        before
+                        after)
+                    (text#= (/.format before)
+                            (/.format after))))
+           )))