aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/math.lux
blob: cee41346aefb431ac989979cddc8b591f8dfdc6c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
(.module:
  [lux #*
   data/text/format
   ["_" test (#+ Test)]
   ["r" math/random (#+ Random)]
   [abstract/monad (#+ Monad do)]
   [data
    ["." bit ("#@." equivalence)]
    [number
     ["." frac ("#@." number)]]]]
  {1
   ["." /]}
  ["." / #_
   ["#." infix]
   ["#." modular]
   ["#." logic #_
    ["#/." continuous]
    ["#/." fuzzy]]])

(def: (within? margin-of-error standard value)
  (-> Frac Frac Frac Bit)
  (f/< margin-of-error
       (frac@abs (f/- standard value))))

(def: margin Frac +0.0000001)

(def: (trigonometric-symmetry forward backward angle)
  (-> (-> Frac Frac) (-> Frac Frac) Frac Bit)
  (let [normal (|> angle forward backward)]
    (|> normal forward backward (within? margin normal))))

(def: #export test
  Test
  (<| (_.context (%name (name-of /._)))
      ($_ _.and
          (<| (_.context "Trigonometry")
              (do r.monad
                [angle (|> r.safe-frac (:: @ map (f/* /.tau)))]
                ($_ _.and
                    (_.test "Sine and arc-sine are inverse functions."
                            (trigonometric-symmetry /.sin /.asin angle))
                    (_.test "Cosine and arc-cosine are inverse functions."
                            (trigonometric-symmetry /.cos /.acos angle))
                    (_.test "Tangent and arc-tangent are inverse functions."
                            (trigonometric-symmetry /.tan /.atan angle))
                    )))
          (<| (_.context "Rounding")
              (do r.monad
                [sample (|> r.safe-frac (:: @ map (f/* +1000.0)))]
                ($_ _.and
                    (_.test "The ceiling will be an integer value, and will be >= the original."
                            (let [ceil'd (/.ceil sample)]
                              (and (|> ceil'd frac-to-int int-to-frac (f/= ceil'd))
                                   (f/>= sample ceil'd)
                                   (f/<= +1.0 (f/- sample ceil'd)))))
                    (_.test "The floor will be an integer value, and will be <= the original."
                            (let [floor'd (/.floor sample)]
                              (and (|> floor'd frac-to-int int-to-frac (f/= floor'd))
                                   (f/<= sample floor'd)
                                   (f/<= +1.0 (f/- floor'd sample)))))
                    (_.test "The round will be an integer value, and will be < or > or = the original."
                            (let [round'd (/.round sample)]
                              (and (|> round'd frac-to-int int-to-frac (f/= round'd))
                                   (f/<= +1.0 (frac@abs (f/- sample round'd))))))
                    )))
          (<| (_.context "Exponentials and logarithms")
              (do r.monad
                [sample (|> r.safe-frac (:: @ map (f/* +10.0)))]
                (_.test "Logarithm is the inverse of exponential."
                        (|> sample /.exp /.log (within? +0.000000000000001 sample)))))
          (<| (_.context "Greatest-Common-Divisor and Least-Common-Multiple")
              (do r.monad
                [#let [gen-nat (|> r.nat (:: @ map (|>> (n/% 1000) (n/max 1))))]
                 x gen-nat
                 y gen-nat]
                ($_ _.and
                    (_.test "GCD"
                            (let [gcd (/.n/gcd x y)]
                              (and (n/= 0 (n/% gcd x))
                                   (n/= 0 (n/% gcd y))
                                   (n/>= 1 gcd))))

                    (_.test "LCM"
                            (let [lcm (/.n/lcm x y)]
                              (and (n/= 0 (n/% x lcm))
                                   (n/= 0 (n/% y lcm))
                                   (n/<= (n/* x y) lcm))))
                    )))

          /infix.test
          /modular.test
          /logic/continuous.test
          /logic/fuzzy.test
          )))