(.module:
  [library
   [lux #*
    ["%" data/text/format (#+ format)]
    ["_" test (#+ Test)]
    [abstract
     [monad (#+ do)]
     [\\specification
      ["$." equivalence]
      ["$." order]
      ["$." codec]]]
    [data
     [collection
      ["." list ("#\." functor)]]]
    ["." math
     ["." random (#+ Random)]]]]
  [\\library
   ["." /
    [//
     ["n" nat]
     ["f" frac]
     ["." int]]]])

... This margin of error is necessary because floating-point arithmetic is not exact.
(def: margin_of_error
  +0.000000001)

(def: dimension
  (Random Frac)
  (do {! random.monad}
    [factor (|> random.nat (\ ! each (|>> (n.% 1000) (n.max 1))))
     measure (|> random.safe_frac (random.only (f.> +0.0)))]
    (in (f.* (|> factor .int int.frac)
             measure))))

(def: .public random
  (Random /.Complex)
  (do random.monad
    [real ..dimension
     imaginary ..dimension]
    (in (/.complex real imaginary))))

(def: angle
  (Random /.Complex)
  (\ random.monad each
     (|>> (revised@ #/.real (f.% +1.0))
          (revised@ #/.imaginary (f.% +1.0)))
     ..random))

(def: construction
  Test
  (do random.monad
    [real ..dimension
     imaginary ..dimension]
    ($_ _.and
        (_.cover [/.complex]
                 (and (let [r+i (/.complex real imaginary)]
                        (and (f.= real (value@ #/.real r+i))
                             (f.= imaginary (value@ #/.imaginary r+i))))
                      (let [r+i (/.complex real)]
                        (and (f.= real (value@ #/.real r+i))
                             (f.= +0.0 (value@ #/.imaginary r+i))))))
        (_.cover [/.approximately?]
                 (/.approximately? ..margin_of_error
                                   (/.complex real imaginary)
                                   (/.complex real imaginary)))
        (_.cover [/.not_a_number?]
                 (and (/.not_a_number? (/.complex f.not_a_number imaginary))
                      (/.not_a_number? (/.complex real f.not_a_number))))
        )))

(def: constant
  Test
  (do random.monad
    [sample ..random
     dimension ..dimension]
    ($_ _.and
        (_.cover [/.zero]
                 (/.= /.zero (/.* /.zero sample)))
        (_.cover [/.+one]
                 (/.= sample (/.* /.+one sample)))
        (_.cover [/.-one]
                 (and (/.= /.zero
                           (/.+ sample
                                (/.* /.-one sample)))
                      (/.= sample (/.* /.-one (/.* /.-one sample)))))
        (_.cover [/.i]
                 (and (/.= (/.complex +0.0 dimension)
                           (/.* /.i (/.complex dimension)))
                      (/.= (/.* /.-one sample)
                           (/.* /.i (/.* /.i sample)))))
        )))

(def: absolute_value&argument
  Test
  (do random.monad
    [real ..dimension
     imaginary ..dimension]
    ($_ _.and
        (_.cover [/.abs]
                 (let [normal!
                       (let [r+i (/.complex real imaginary)]
                         (and (f.>= (f.abs real) (/.abs r+i))
                              (f.>= (f.abs imaginary) (/.abs r+i))))

                       not_a_number!
                       (and (f.not_a_number? (/.abs (/.complex f.not_a_number imaginary)))
                            (f.not_a_number? (/.abs (/.complex real f.not_a_number))))

                       infinity!
                       (and (f.= f.positive_infinity (/.abs (/.complex f.positive_infinity imaginary)))
                            (f.= f.positive_infinity (/.abs (/.complex real f.positive_infinity)))
                            (f.= f.positive_infinity (/.abs (/.complex f.negative_infinity imaginary)))
                            (f.= f.positive_infinity (/.abs (/.complex real f.negative_infinity))))]
                   (and normal!
                        not_a_number!
                        infinity!)))
        ... https://en.wikipedia.org/wiki/Argument_(complex_analysis)#Identities
        (_.cover [/.argument]
                 (let [sample (/.complex real imaginary)]
                   (or (/.= /.zero sample)
                       (/.approximately? ..margin_of_error
                                         sample
                                         (/.*' (/.abs sample)
                                               (/.exp (/.* /.i (/.complex (/.argument sample)))))))))
        )))

(def: number
  Test
  (do random.monad
    [x ..random
     y ..random
     factor ..dimension]
    ($_ _.and
        (_.cover [/.+]
                 (let [z (/.+ y x)]
                   (and (/.= z
                             (/.complex (f.+ (value@ #/.real y)
                                             (value@ #/.real x))
                                        (f.+ (value@ #/.imaginary y)
                                             (value@ #/.imaginary x)))))))
        (_.cover [/.-]
                 (let [normal!
                       (let [z (/.- y x)]
                         (and (/.= z
                                   (/.complex (f.- (value@ #/.real y)
                                                   (value@ #/.real x))
                                              (f.- (value@ #/.imaginary y)
                                                   (value@ #/.imaginary x))))))

                       inverse!
                       (and (|> x (/.+ y) (/.- y) (/.approximately? ..margin_of_error x))
                            (|> x (/.- y) (/.+ y) (/.approximately? ..margin_of_error x)))]
                   (and normal!
                        inverse!)))
        (_.cover [/.* /./]
                 (|> x (/.* y) (/./ y) (/.approximately? ..margin_of_error x)))
        (_.cover [/.*' /./']
                 (|> x (/.*' factor) (/./' factor) (/.approximately? ..margin_of_error x)))
        (_.cover [/.%]
                 (let [rem (/.% y x)
                       quotient (|> x (/.- rem) (/./ y))
                       floored (|> quotient
                                   (revised@ #/.real math.floor)
                                   (revised@ #/.imaginary math.floor))]
                   (/.approximately? +0.000000000001
                                     x
                                     (|> quotient (/.* y) (/.+ rem)))))
        )))

(def: conjugate&reciprocal&signum&negation
  Test
  (do random.monad
    [x ..random]
    ($_ _.and
        (_.cover [/.conjugate]
                 (let [cx (/.conjugate x)]
                   (and (f.= (value@ #/.real x)
                             (value@ #/.real cx))
                        (f.= (f.opposite (value@ #/.imaginary x))
                             (value@ #/.imaginary cx)))))
        (_.cover [/.reciprocal]
                 (let [reciprocal!
                       (|> x (/.* (/.reciprocal x)) (/.approximately? ..margin_of_error /.+one))
                       
                       own_inverse!
                       (|> x /.reciprocal /.reciprocal (/.approximately? ..margin_of_error x))]
                   (and reciprocal!
                        own_inverse!)))
        (_.cover [/.signum]
                 ... Absolute value of signum is always root/2(2), 1 or 0.
                 (let [signum_abs (|> x /.signum /.abs)]
                   (or (f.= +0.0 signum_abs)
                       (f.= +1.0 signum_abs)
                       (f.= (math.pow +0.5 +2.0) signum_abs))))
        (_.cover [/.opposite]
                 (let [own_inverse!
                       (let [there (/.opposite x)
                             back_again (/.opposite there)]
                         (and (not (/.= there x))
                              (/.= back_again x)))

                       absolute!
                       (f.= (/.abs x)
                            (/.abs (/.opposite x)))]
                   (and own_inverse!
                        absolute!)))
        )))

(def: (trigonometric_symmetry forward backward angle)
  (-> (-> /.Complex /.Complex) (-> /.Complex /.Complex) /.Complex Bit)
  (let [normal (|> angle forward backward)]
    (|> normal forward backward (/.approximately? ..margin_of_error normal))))

(def: trigonometry
  Test
  (do {! random.monad}
    [angle ..angle]
    ($_ _.and
        (_.cover [/.sin /.asin]
                 (trigonometric_symmetry /.sin /.asin angle))
        (_.cover [/.cos /.acos]
                 (trigonometric_symmetry /.cos /.acos angle))
        (_.cover [/.tan /.atan]
                 (trigonometric_symmetry /.tan /.atan angle)))))

(def: hyperbolic
  Test
  (do {! random.monad}
    [angle ..angle]
    ($_ _.and
        (_.cover [/.sinh]
                 (/.approximately? ..margin_of_error
                                   (|> angle (/.* /.i) /.sin (/.* /.i) (/.* /.-one))
                                   (/.sinh angle)))
        (_.cover [/.cosh]
                 (/.approximately? ..margin_of_error
                                   (|> angle (/.* /.i) /.cos)
                                   (/.cosh angle)))
        (_.cover [/.tanh]
                 (/.approximately? ..margin_of_error
                                   (|> angle (/.* /.i) /.tan (/.* /.i) (/.* /.-one))
                                   (/.tanh angle)))
        )))

(def: exponentiation&logarithm
  Test
  (do random.monad
    [x ..random]
    ($_ _.and
        (_.cover [/.pow /.root/2]
                 (|> x (/.pow (/.complex +2.0)) /.root/2 (/.approximately? ..margin_of_error x)))
        (_.cover [/.pow']
                 (|> x (/.pow' +2.0) (/.pow' +0.5) (/.approximately? ..margin_of_error x)))
        (_.cover [/.log /.exp]
                 (|> x /.log /.exp (/.approximately? ..margin_of_error x)))
        )))

(def: root
  Test
  (do {! random.monad}
    [sample ..random
     degree (|> random.nat (\ ! each (|>> (n.max 1) (n.% 5))))]
    (_.cover [/.roots]
             (|> sample
                 (/.roots degree)
                 (list\each (/.pow' (|> degree .int int.frac)))
                 (list.every? (/.approximately? ..margin_of_error sample))))))

(def: .public test
  Test
  (<| (_.covering /._)
      (_.for [/.Complex])
      ($_ _.and
          (_.for [/.= /.equivalence]
                 ($equivalence.spec /.equivalence ..random))

          ..construction
          ..constant
          ..absolute_value&argument
          ..number
          ..conjugate&reciprocal&signum&negation
          ..trigonometry
          ..hyperbolic
          ..exponentiation&logarithm
          ..root
          )))