{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE GADTs, StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}

-- |
-- Module      : OAlg.Structure.Number.Definition
-- Description : definition of numbers as ordered semi rings with infinitely many elements
-- Copyright   : (c) Erich Gut
-- License     : BSD3
-- Maintainer  : zerich.gut@gmail.com
-- 
-- definition of numbers as ordered 'Semiring' with infinitely many elements.
module OAlg.Structure.Number.Definition
  (
    -- * Number
    Number(..), zFloor

    -- | digital represenation of numbers
  , toDigits, Digits(..)
  , toDigitsFinite, fromDigits
  , dgsBase, dgsProxy, dgsFrcTake

    -- * Integral
  , Integral(..), primes

    -- * Acyclic
  , Acyclic(..)

    -- * Fractional
  , Fractional

    -- * Measurable
  , Measurable(..)
  )
  where

import qualified Prelude as A

import Data.Proxy

import OAlg.Prelude

import OAlg.Data.TypeLits
import OAlg.Data.Canonical

import OAlg.Structure.Oriented.Definition
import OAlg.Structure.Multiplicative.Definition
import OAlg.Structure.Additive.Definition
import OAlg.Structure.Distributive.Definition
import OAlg.Structure.Ring.Definition

--------------------------------------------------------------------------------
-- Number -

-- | ordered commutative semi ring where v'+' and v'*' respect the given ordering.
--
-- __Definitions__
--
-- (1) A number @x@ is called __/positive/__ if @0 < x@ and __/negative/__ if @x < 0@.
--
-- (2) A number structure is called __/positive/__ if it contains no negative elements.
--
-- __Properties__
--
-- (1) @1@ is positive.
--
-- (2) For all @x < y@ and @z@ holds: @x v'+' z < y v'+' z@
--
-- (3) For all @0 < x@, @0 < y@ holds: @0 < x v'*' y@.
--
-- (4) For all @x@ holds: @x == 'signum' x v'*' 'abs' x@.
--
-- (5) For all @x@ holds: @'floor' x  v'+' 'fraction' x == x@.
--
-- __Note__
--
-- (1) A not positive structure of numbers contain always also the additive inverse of @1@
-- which is negative.
--
-- (2) Structures of numbers have infinitely many values, because from the
-- properties above follows that
-- @0 < 1 < 2 < .. < 'ntimes' n 1 < 'ntimes' (n v'+' 1) 1 < .. @ for all @0 <= n@.
class (Semiring r, Commutative r, Ord r) => Number r where
  {-# MINIMAL minusOne, zFloorFraction #-}

  -- | the additive inverse of @1@ - if it exists - and will be
  --   denoted by @-1@ (see the note above).
  minusOne :: Maybe r

  -- | sign of a number.
  --
  -- __Property__ For all @x@ holds: if @0 < x@ then @signum x == 1@ and if @x == 0@
  -- then @signum x == 0@ and if @x < 0@ then @signum x == -1@ (for @-1@ see @'minusOne'@).
  --
  -- __Note__ The default implementation is:
  --
  -- @
  -- signum x = case rZero `compare` x of
  --              GT -> rOne
  --              EQ -> rZero
  --              LT -> e where Just e = minusOne
  -- @
  signum :: r -> r
  signum r
x = case forall r. Semiring r => r
rZero forall a. Ord a => a -> a -> Ordering
`compare` r
x of
             Ordering
GT -> forall r. Semiring r => r
rOne
             Ordering
EQ -> forall r. Semiring r => r
rZero
             Ordering
LT -> r
e where Just r
e = forall r. Number r => Maybe r
minusOne
             
  -- | absolute value of a number.
  --
  -- __Definition__ The __/absolute value/__ of a @x@ is defined by
  -- @abs x = 'signum' x v'*' x@ (which serves as the default implementation).
  --
  -- __Properties__ For all @x@ holds:
  --
  -- (1) @0 <= abs x@.
  --
  -- (2) if @0 <= x@ then @abs x == x@.
  abs :: r -> r
  abs r
x = forall r. Number r => r -> r
signum r
x forall c. Multiplicative c => c -> c -> c
* r
x

  -- | floor of a value of a number.
  --
  -- __Properties__
  --
  -- (1) @floor 0 == 0@.
  --
  -- (2) For all @x@ holds: @floor (x v'+' 1) = floor x v'+' 1@.
  floor :: r -> r
  floor r
x = forall a. Additive a => N -> a -> a
ntimes (forall a b. Projectible a b => b -> a
prj forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a b. (a, b) -> a
fst forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall r. Number r => r -> (Z, r)
zFloorFraction forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ r
x) (forall r. Number r => r -> r
signum r
x)

  -- | fractional part of a number.
  --
  -- __Property__ For all @x@ holds: 0 <= fraction x < 1.
  fraction :: r -> r
  fraction = forall a b. (a, b) -> b
snd forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. forall r. Number r => r -> (Z, r)
zFloorFraction

  -- | simultaneous evaluation of @'floor'@ - represented as an integer - and its
  -- @'fraction'@.
  --
  -- __Properties__ For all @x@ holds:
  --
  -- (1) @'floor' x == 'ntimes' ('prj' '$' fst '$' 'zFloorFraction' '$' x) ('signum' x)@.
  --
  -- (2) @'fraction' x == 'snd' '.' 'zFloorFraction'@.
  --
  -- __Note__ This properties are used for the default implementation of @'floor'@
  -- and @'fraction'@.
  zFloorFraction :: r -> (Z,r)

--------------------------------------------------------------------------------
-- zFloor -

-- | floor to 'Z'.
zFloor :: Number r => r -> Z
zFloor :: forall r. Number r => r -> Z
zFloor = forall a b. (a, b) -> a
fstforall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. forall r. Number r => r -> (Z, r)
zFloorFraction

--------------------------------------------------------------------------------
-- Number - Instances -

instance Number N where
  minusOne :: Maybe N
minusOne          = forall a. Maybe a
Nothing
  abs :: N -> N
abs             N
n = N
n
  signum :: N -> N
signum          N
n = if N
n forall a. Eq a => a -> a -> Bool
== N
0 then N
0 else N
1
  floor :: N -> N
floor           N
n = N
n
  fraction :: N -> N
fraction        N
_ = N
0
  zFloorFraction :: N -> (Z, N)
zFloorFraction  N
n = (forall a b. Embeddable a b => a -> b
inj N
n, N
0)  
  
instance Number Integer where
  minusOne :: Maybe Integer
minusOne         = forall a. a -> Maybe a
Just (-Integer
1)
  abs :: Integer -> Integer
abs              = forall a. Num a => a -> a
A.abs
  signum :: Integer -> Integer
signum           = forall a. Num a => a -> a
A.signum
  floor :: Integer -> Integer
floor          Integer
z = Integer
z
  fraction :: Integer -> Integer
fraction       Integer
_ = Integer
0
  zFloorFraction :: Integer -> (Z, Integer)
zFloorFraction Integer
z = (forall a b. Embeddable a b => a -> b
inj Integer
z,Integer
0)

instance Number Z where
  minusOne :: Maybe Z
minusOne         = forall a. a -> Maybe a
Just (-Z
1)
  abs :: Z -> Z
abs              = forall a. Num a => a -> a
A.abs
  signum :: Z -> Z
signum           = forall a. Num a => a -> a
A.signum
  floor :: Z -> Z
floor          Z
z = Z
z
  fraction :: Z -> Z
fraction       Z
_ = Z
0
  zFloorFraction :: Z -> (Z, Z)
zFloorFraction Z
z = (Z
z,Z
0)

instance Number Q where
  minusOne :: Maybe Q
minusOne       = forall a. a -> Maybe a
Just (-Q
1)
  abs :: Q -> Q
abs            = forall a. Num a => a -> a
A.abs
  signum :: Q -> Q
signum         = forall a. Num a => a -> a
A.signum
  floor :: Q -> Q
floor  Q
q       = forall a b. (RealFrac a, Integral b) => a -> b
A.floor Q
q Z -> N -> Q
% N
1
  zFloorFraction :: Q -> (Z, Q)
zFloorFraction = forall a b. (RealFrac a, Integral b) => a -> (b, a)
A.properFraction

--------------------------------------------------------------------------------
-- Integral -

-- | discrete numbers.
--
-- __Property__ For all @x@ holds: @'fraction' x '==' 0@.
class Number a => Integral a where
  {-# MINIMAL divMod #-}

  divMod :: a -> a -> (a,a)

  div :: a -> a -> a
  div a
a a
b = forall a b. (a, b) -> a
fst (forall a. Integral a => a -> a -> (a, a)
divMod a
a a
b)

  mod :: a -> a -> a
  mod a
a a
b = forall a b. (a, b) -> b
snd (forall a. Integral a => a -> a -> (a, a)
divMod a
a a
b)

instance Integral N where
  divMod :: N -> N -> (N, N)
divMod = forall a. Integral a => a -> a -> (a, a)
A.divMod
  div :: N -> N -> N
div    = forall a. Integral a => a -> a -> a
A.div
  mod :: N -> N -> N
mod    = forall a. Integral a => a -> a -> a
A.mod
  
instance Integral Z where
  divMod :: Z -> Z -> (Z, Z)
divMod = forall a. Integral a => a -> a -> (a, a)
A.divMod
  div :: Z -> Z -> Z
div    = forall a. Integral a => a -> a -> a
A.div
  mod :: Z -> Z -> Z
mod    = forall a. Integral a => a -> a -> a
A.mod
  
--------------------------------------------------------------------------------
-- primes 

-- | the list of prime numbers.
primes :: [N]
primes :: [N]
primes = forall {a}. (Integral a, Num a) => [a] -> [a]
filterPrime [N
2..]
  where filterPrime :: [a] -> [a]
filterPrime (a
p:[a]
xs) = a
p forall a. a -> [a] -> [a]
: [a] -> [a]
filterPrime [a
x | a
x <- [a]
xs, a
x forall a. Integral a => a -> a -> a
`mod` a
p forall a. Eq a => a -> a -> Bool
/= a
0]

--------------------------------------------------------------------------------
-- Acyclic -

-- | distributive structure with entities scaleable by 'Q'.
--
-- __Property__ For every @0 '<' n@ and point @p@ holds: @'ntimes' n ('one' p)@ is
-- invertible.
--
-- __Note__
--
-- (1) The cyclic rings @'OAlg.Entity.Commutative.Mod' n@ for @2 <= n@ are not scaleable by
-- @'Q'@, because @1 '/=' 0@ and @'ntimes' n 1 '==' 0@!
--
-- (2) If for every point @p@ holds that @'zero' (p':>'p) '==' 'one' p@ then the structure
-- is scaleable by 'Q' (e.g. @'Orientation' p@).
class (Distributive a, Abelian a, Invertible a) => Acyclic a where
  
  -- | @'qtimes' q a '==' 'ztimes' z a v'*' 'invert' ('ntimes' n ('one' ('start' a)))@.
  --   where @z = 'numerator' q@ and @n = 'denominator' q@.
  qtimes :: Q -> a -> a
  qtimes Q
q a
a = forall a. Abelian a => Z -> a -> a
ztimes Z
z a
a forall c. Multiplicative c => c -> c -> c
* forall c. Invertible c => c -> c
invert (forall a. Additive a => N -> a -> a
ntimes N
n (forall c. Multiplicative c => Point c -> c
one (forall q. Oriented q => q -> Point q
start a
a)))
    where z :: Z
z = Q -> Z
numerator Q
q
          n :: N
n = Q -> N
denominator Q
q

instance Acyclic () where
  qtimes :: Q -> () -> ()
qtimes Q
_ ()
_ = ()
  
instance Acyclic Q where
  qtimes :: Q -> Q -> Q
qtimes = forall c. Multiplicative c => c -> c -> c
(*)
  
--------------------------------------------------------------------------------
-- Fractional -

-- | continuous numbers, i.e acyclic and negateable numbers. They induce a sub
--   @'Q'@-vectorial structures of the real numbers.
--
--   __Note__ We will distinguish here instances of @'Fractional'@ and the mathematical
--   entities of real numbers! 
type Fractional r = (Number r, Abelian r, Acyclic r)

--------------------------------------------------------------------------------
-- Measurable -

-- | measurable entities.
class (Entity a, Number r) => Measurable a r where

  -- | distance of two points.
  --
  --   __Properties__ Let @__a__@ @__r__@ be 'Measurable', then holds:
  --
  --   (1) For all @x@ and @y@ in @__a__@ holds: @0 <= dist x y@
  --
  --   (2) For all @x@ and @y@ in @__a__@ holds: @dist x y == 0@ if and only if @x == y@.
  --
  --   (3) For all @x@ and @y@ in @__a__@ holds: @dist x y == dist y x@.
  --
  --   (4) For all @x@, @y@ and @z@ in @__a__@ holds: @dist x z@ <= @dist x y@ v'+' @dist y z@
  dist :: a -> a -> r

instance (Number r, Abelian r) => Measurable r r where
  dist :: r -> r -> r
dist r
a r
b = forall r. Number r => r -> r
abs (r
b forall a. Abelian a => a -> a -> a
- r
a)

instance Measurable N Z where
  dist :: N -> N -> Z
dist N
a N
b = forall a b. Embeddable a b => a -> b
inj forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall a. Num a => a -> a
A.abs forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ (N
b forall a. Num a => a -> a -> a
A.- N
a)

----------------------------------------
-- Digits -

-- | digital representation of numbers for the given base @b@.
--
-- __Note__
--
-- (1) 'dgsFlr' is a finite list
--
-- (2) 'dgsFrc' maybe a infinite list and as such 'valid' could end up in an
-- infinite proposition!
data Digits (b :: Nat) r where
  Digits :: 2 <= b
    => { forall (b :: Natural) r. Digits b r -> r
dgsSig :: r    -- ^ the signum.
       , forall (b :: Natural) r. Digits b r -> [N]
dgsFlr :: [N]  -- ^ the digital representation of the floor part
       , forall (b :: Natural) r. Digits b r -> [N]
dgsFrc :: [N]  -- ^ the digital representation of the fractional part
       }
    -> Digits b r

deriving instance Show r => Show (Digits b r)
deriving instance Eq r => Eq (Digits b r)
deriving instance Ord r => Ord (Digits b r)

instance Validable r => Validable (Digits b r) where
  valid :: Digits b r -> Statement
valid (Digits r
r [N]
n [N]
m) = [Statement] -> Statement
And [forall a. Validable a => a -> Statement
valid r
r,forall a. Validable a => a -> Statement
valid [N]
n,forall a. Validable a => a -> Statement
valid [N]
m]
  
instance (KnownNat b, Entity r) => Entity (Digits b r)

--------------------------------------------------------------------------------
-- dgsProxy -

-- | the proxy with the same type @b@.
dgsProxy :: Digits b r -> Proxy b
dgsProxy :: forall (b :: Natural) r. Digits b r -> Proxy b
dgsProxy Digits b r
_ = forall {k} (t :: k). Proxy t
Proxy 

--------------------------------------------------------------------------------
-- dgsBase -

-- | the base of a digit, i.e. the corresponding natural number of the type literal @b@.
dgsBase :: KnownNat b => Digits b r -> N
dgsBase :: forall (b :: Natural) r. KnownNat b => Digits b r -> N
dgsBase = forall a b. Projectible a b => b -> a
prj forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. forall (b :: Natural) r. Digits b r -> Proxy b
dgsProxy

--------------------------------------------------------------------------------
-- dgsFrcTake -

-- | limits the fractional part 'dgsFrc' to the length of @n@.
dgsFrcTake :: N -> Digits b r -> Digits b r
dgsFrcTake :: forall (b :: Natural) r. N -> Digits b r -> Digits b r
dgsFrcTake N
n (Digits r
r [N]
flr [N]
frc) = forall (b :: Natural) r. (2 <= b) => r -> [N] -> [N] -> Digits b r
Digits r
r [N]
flr (forall a. N -> [a] -> [a]
takeN N
n forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ [N]
frc)

--------------------------------------------------------------------------------
-- toDigits -
-- | the digital representation of @x@ in the base @b@.
--
--   Let @'Digits' s xs ys = 'toDigits' r@ then
--
--   * @s@ is the @'signum' x@.
--
--   * @xs@ is the digital representation of @'abs' ('floor' x)@ .
--
--   * @ys@ is the - possibly infinite - digital representation of @'abs' ('fraction' x)@
--     in the base @b@.
--
--   __Examples__
--
-- >>> toDigits (1/3) :: Digits 10 Q
-- Digits 1 [] [3,3,3..]
--
-- >>> toDigits (-4/3) :: Digits 3 Q
-- Digits (-1) [1] [1]
--
-- __Note__ To get the first @n@ digits of the fractional part @ys@ for the digital
-- representation of @x@ use @'toDigitsFinite' n x@.
toDigits :: (Number r, KnownNat b, 2 <= b) => r -> Digits b r
toDigits :: forall r (b :: Natural).
(Number r, KnownNat b, 2 <= b) =>
r -> Digits b r
toDigits r
x = Digits b r
res
  where res :: Digits b r
res   = forall (b :: Natural) r. (2 <= b) => r -> [N] -> [N] -> Digits b r
Digits r
sig (Z -> [N] -> [N]
dgtsFlr Z
z []) (r -> [N]
dgtsFrc r
f)
        base :: N
base  = forall (b :: Natural) r. KnownNat b => Digits b r -> N
dgsBase Digits b r
res
        sig :: r
sig   = forall r. Number r => r -> r
signum r
x
        (Z
z,r
f) = forall r. Number r => r -> (Z, r)
zFloorFraction forall (h :: * -> * -> *) a b. Applicative h => h a b -> a -> b
$ forall r. Number r => r -> r
abs r
x
          
        zbs :: Z
zbs          = forall a b. Embeddable a b => a -> b
inj N
base
        dgtsFlr :: Z -> [N] -> [N]
dgtsFlr Z
t [N]
ds = if Z
t forall a. Eq a => a -> a -> Bool
== forall r. Semiring r => r
rZero then [N]
ds else Z -> [N] -> [N]
dgtsFlr Z
z' [N]
ds'
          where (Z
z',Z
zn) = forall a. Integral a => a -> a -> (a, a)
divMod Z
t Z
zbs
                ds' :: [N]
ds'     = forall a b. Projectible a b => b -> a
prj Z
zn forall a. a -> [a] -> [a]
: [N]
ds
          
        dgtsFrc :: r -> [N]
dgtsFrc r
frc = if r
frc forall a. Eq a => a -> a -> Bool
== forall r. Semiring r => r
rZero then [] else forall a b. Projectible a b => b -> a
prj Z
flr forall a. a -> [a] -> [a]
: r -> [N]
dgtsFrc r
frc'
          where (Z
flr,r
frc') = forall r. Number r => r -> (Z, r)
zFloorFraction (forall a. Additive a => N -> a -> a
ntimes N
base r
frc)

--------------------------------------------------------------------------------
-- toDigitsFinite -

-- | @toDigitsFinite n@ is like 'toDigits' but the fractional part is limited to the
-- length of @n@ and is given by @'dgsFrcTake' n '.' 'toDigits'@.
toDigitsFinite :: (Number r, KnownNat b, 2 <= b) => N -> r -> Digits b r
toDigitsFinite :: forall r (b :: Natural).
(Number r, KnownNat b, 2 <= b) =>
N -> r -> Digits b r
toDigitsFinite N
n = forall (b :: Natural) r. N -> Digits b r -> Digits b r
dgsFrcTake N
n forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. forall r (b :: Natural).
(Number r, KnownNat b, 2 <= b) =>
r -> Digits b r
toDigits

--------------------------------------------------------------------------------
-- fromDigits -

-- | @fromDigits n dgs\@('Digits' s xs ys)@ is given by
--   @s v'*' (xm v'*' b'^'m v'+' .. v'+' xi v'*' b'^'i v'+' .. v'+' x0 v'*' b'^'0  v'+' y1 v'*' r'^'1 v'+' .. v'+' yj v'*' r'^'j v'+' .. v'+' yn v'*' r'^'n@
-- where @b = 'dgsBase' dgs@, @xs = [xm..xi..x0]@, @ys = [y1,y2..yj..yn..]@
-- and @r = 'invert' b@.
--
-- __Property__ Let @1 '<' b@ and @dgs = 'Digits' s xs ys@ where @s@ is either 1 or -1
-- and @0 v'<=' xi '<' b@ for all @i@ and @0 v'<=' yj '<' b@ for all @j@
-- then for all @n@ holds: @'toDigits' b n ('fromDigits' b n dgs) '==' dgs@.
--
-- __Note__
--
-- (1) All the elements of the above formula are lifted to the type @r@ via
-- @\\x -> 'ntimes' x 'rOne'@.
--
-- (2) Because the type @r@ is acyclic, the expression @'invert' b@ - which is actually
-- @'invert' ('ntimes' b 'rOne')@ - is regular.
--
-- (3) If @b@ is not bigger then 1 then an exception 'Undefined' will be thrown.
fromDigits :: (Number r, Acyclic r, KnownNat b) => N -> Digits b r -> r
fromDigits :: forall r (b :: Natural).
(Number r, Acyclic r, KnownNat b) =>
N -> Digits b r -> r
fromDigits N
n dgs :: Digits b r
dgs@(Digits r
s [N]
flr [N]
frc)
  = r
s forall c. Multiplicative c => c -> c -> c
* (forall r. Number r => r -> [N] -> r -> r
rFlr r
b' [N]
flr forall r. Semiring r => r
rZero forall a. Additive a => a -> a -> a
+ forall r. Number r => r -> r -> [N] -> r -> r
rFrc r
br r
br (forall a. N -> [a] -> [a]
takeN N
n [N]
frc) forall r. Semiring r => r
rZero) where
    b :: N
b  = forall (b :: Natural) r. KnownNat b => Digits b r -> N
dgsBase Digits b r
dgs
    b' :: r
b' = forall a. Additive a => N -> a -> a
ntimes N
b forall r. Semiring r => r
rOne
    br :: r
br = forall c. Invertible c => c -> c
invert r
b'
        -- invert b' is regular, because r is acyclic!!
        
    rFlr :: Number r => r -> [N] -> r -> r
    rFlr :: forall r. Number r => r -> [N] -> r -> r
rFlr r
_ []     r
r = r
r
    rFlr r
x (N
d:[N]
ds) r
r = forall r. Number r => r -> [N] -> r -> r
rFlr r
x [N]
ds (r
x forall c. Multiplicative c => c -> c -> c
* r
r forall a. Additive a => a -> a -> a
+ forall a. Additive a => N -> a -> a
ntimes N
d forall r. Semiring r => r
rOne)

    rFrc :: Number r => r -> r -> [N] -> r -> r
    rFrc :: forall r. Number r => r -> r -> [N] -> r -> r
rFrc r
_  r
_ [] r
r    = r
r
    rFrc r
x r
y (N
d:[N]
ds) r
r = forall r. Number r => r -> r -> [N] -> r -> r
rFrc r
x r
z [N]
ds (r
r forall a. Additive a => a -> a -> a
+ r
y forall c. Multiplicative c => c -> c -> c
* forall a. Additive a => N -> a -> a
ntimes N
d forall r. Semiring r => r
rOne) where z :: r
z = r
xforall c. Multiplicative c => c -> c -> c
*r
y