{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE GADTs, StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
module OAlg.Structure.Number.Definition
(
Number(..), zFloor
, toDigits, Digits(..)
, toDigitsFinite, fromDigits
, dgsBase, dgsProxy, dgsFrcTake
, Integral(..), primes
, Acyclic(..)
, Fractional
, 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
class (Semiring r, Commutative r, Ord r) => Number r where
{-# MINIMAL minusOne, zFloorFraction #-}
minusOne :: Maybe r
signum :: r -> r
signum r
x = case r
forall r. Semiring r => r
rZero r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` r
x of
Ordering
GT -> r
forall r. Semiring r => r
rOne
Ordering
EQ -> r
forall r. Semiring r => r
rZero
Ordering
LT -> r
e where Just r
e = Maybe r
forall r. Number r => Maybe r
minusOne
abs :: r -> r
abs r
x = r -> r
forall r. Number r => r -> r
signum r
x r -> r -> r
forall c. Multiplicative c => c -> c -> c
* r
x
floor :: r -> r
floor r
x = N -> r -> r
forall a. Additive a => N -> a -> a
ntimes (Z -> N
forall a b. Projectible a b => b -> a
prj (Z -> N) -> Z -> N
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ (Z, r) -> Z
forall a b. (a, b) -> a
fst ((Z, r) -> Z) -> (Z, r) -> Z
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ r -> (Z, r)
forall r. Number r => r -> (Z, r)
zFloorFraction (r -> (Z, r)) -> r -> (Z, r)
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ r
x) (r -> r
forall r. Number r => r -> r
signum r
x)
fraction :: r -> r
fraction = (Z, r) -> r
forall a b. (a, b) -> b
snd ((Z, r) -> r) -> (r -> (Z, r)) -> r -> r
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. r -> (Z, r)
forall r. Number r => r -> (Z, r)
zFloorFraction
zFloorFraction :: r -> (Z,r)
zFloor :: Number r => r -> Z
zFloor :: forall r. Number r => r -> Z
zFloor = (Z, r) -> Z
forall a b. (a, b) -> a
fst((Z, r) -> Z) -> (r -> (Z, r)) -> r -> Z
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. r -> (Z, r)
forall r. Number r => r -> (Z, r)
zFloorFraction
instance Number N where
minusOne :: Maybe N
minusOne = Maybe N
forall a. Maybe a
Nothing
abs :: N -> N
abs N
n = N
n
signum :: N -> N
signum N
n = if N
n N -> N -> Bool
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 = (N -> Z
forall a b. Embeddable a b => a -> b
inj N
n, N
0)
instance Number Integer where
minusOne :: Maybe Integer
minusOne = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (-Integer
1)
abs :: Integer -> Integer
abs = Integer -> Integer
forall a. Num a => a -> a
A.abs
signum :: Integer -> Integer
signum = Integer -> Integer
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 = (Integer -> Z
forall a b. Embeddable a b => a -> b
inj Integer
z,Integer
0)
instance Number Z where
minusOne :: Maybe Z
minusOne = Z -> Maybe Z
forall a. a -> Maybe a
Just (-Z
1)
abs :: Z -> Z
abs = Z -> Z
forall a. Num a => a -> a
A.abs
signum :: Z -> Z
signum = Z -> Z
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 = Q -> Maybe Q
forall a. a -> Maybe a
Just (-Q
1)
abs :: Q -> Q
abs = Q -> Q
forall a. Num a => a -> a
A.abs
signum :: Q -> Q
signum = Q -> Q
forall a. Num a => a -> a
A.signum
floor :: Q -> Q
floor Q
q = Q -> Z
forall b. Integral b => Q -> b
forall a b. (RealFrac a, Integral b) => a -> b
A.floor Q
q Z -> N -> Q
% N
1
zFloorFraction :: Q -> (Z, Q)
zFloorFraction = Q -> (Z, Q)
forall b. Integral b => Q -> (b, Q)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
A.properFraction
class Number a => Integral a where
{-# MINIMAL divMod #-}
divMod :: a -> a -> (a,a)
div :: a -> a -> a
div a
a a
b = (a, a) -> a
forall a b. (a, b) -> a
fst (a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod a
a a
b)
mod :: a -> a -> a
mod a
a a
b = (a, a) -> a
forall a b. (a, b) -> b
snd (a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod a
a a
b)
instance Integral N where
divMod :: N -> N -> (N, N)
divMod = N -> N -> (N, N)
forall a. Integral a => a -> a -> (a, a)
A.divMod
div :: N -> N -> N
div = N -> N -> N
forall a. Integral a => a -> a -> a
A.div
mod :: N -> N -> N
mod = N -> N -> N
forall a. Integral a => a -> a -> a
A.mod
instance Integral Z where
divMod :: Z -> Z -> (Z, Z)
divMod = Z -> Z -> (Z, Z)
forall a. Integral a => a -> a -> (a, a)
A.divMod
div :: Z -> Z -> Z
div = Z -> Z -> Z
forall a. Integral a => a -> a -> a
A.div
mod :: Z -> Z -> Z
mod = Z -> Z -> Z
forall a. Integral a => a -> a -> a
A.mod
primes :: [N]
primes :: [N]
primes = [N] -> [N]
forall {a}. (Integral a, Num a) => [a] -> [a]
filterPrime [N
2..]
where filterPrime :: [a] -> [a]
filterPrime (a
p:[a]
xs) = a
p a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
filterPrime [a
x | a
x <- [a]
xs, a
x a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
p a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0]
class (Distributive a, Abelian a, Invertible a) => Acyclic a where
qtimes :: Q -> a -> a
qtimes Q
q a
a = Z -> a -> a
forall a. Abelian a => Z -> a -> a
ztimes Z
z a
a a -> a -> a
forall c. Multiplicative c => c -> c -> c
* a -> a
forall c. Invertible c => c -> c
invert (N -> a -> a
forall a. Additive a => N -> a -> a
ntimes N
n (Point a -> a
forall c. Multiplicative c => Point c -> c
one (a -> Point a
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 = Q -> Q -> Q
forall c. Multiplicative c => c -> c -> c
(*)
type Fractional r = (Number r, Abelian r, Acyclic r)
class (Entity a, Number r) => Measurable a r where
dist :: a -> a -> r
instance (Number r, Abelian r) => Measurable r r where
dist :: r -> r -> r
dist r
a r
b = r -> r
forall r. Number r => r -> r
abs (r
b r -> r -> r
forall a. Abelian a => a -> a -> a
- r
a)
instance Measurable N Z where
dist :: N -> N -> Z
dist N
a N
b = N -> Z
forall a b. Embeddable a b => a -> b
inj (N -> Z) -> N -> Z
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ N -> N
forall a. Num a => a -> a
A.abs (N -> N) -> N -> N
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ (N
b N -> N -> N
forall a. Num a => a -> a -> a
A.- N
a)
data Digits (b :: Nat) r where
Digits :: 2 <= b
=> { forall (b :: Natural) r. Digits b r -> r
dgsSig :: r
, forall (b :: Natural) r. Digits b r -> [N]
dgsFlr :: [N]
, forall (b :: Natural) r. Digits b r -> [N]
dgsFrc :: [N]
}
-> 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 [r -> Statement
forall a. Validable a => a -> Statement
valid r
r,[N] -> Statement
forall a. Validable a => a -> Statement
valid [N]
n,[N] -> Statement
forall a. Validable a => a -> Statement
valid [N]
m]
dgsProxy :: Digits b r -> Proxy b
dgsProxy :: forall (b :: Natural) r. Digits b r -> Proxy b
dgsProxy Digits b r
_ = Proxy b
forall {k} (t :: k). Proxy t
Proxy
dgsBase :: KnownNat b => Digits b r -> N
dgsBase :: forall (b :: Natural) r. KnownNat b => Digits b r -> N
dgsBase = Integer -> N
forall a b. Projectible a b => b -> a
prj (Integer -> N) -> (Digits b r -> Integer) -> Digits b r -> N
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. Proxy b -> Integer
forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy b -> Integer)
-> (Digits b r -> Proxy b) -> Digits b r -> Integer
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. Digits b r -> Proxy b
forall (b :: Natural) r. Digits b r -> Proxy b
dgsProxy
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) = r -> [N] -> [N] -> Digits b r
forall (b :: Natural) r. (2 <= b) => r -> [N] -> [N] -> Digits b r
Digits r
r [N]
flr (N -> [N] -> [N]
forall a. N -> [a] -> [a]
takeN N
n ([N] -> [N]) -> [N] -> [N]
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ [N]
frc)
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 = r -> [N] -> [N] -> Digits b r
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 = Digits b r -> N
forall (b :: Natural) r. KnownNat b => Digits b r -> N
dgsBase Digits b r
res
sig :: r
sig = r -> r
forall r. Number r => r -> r
signum r
x
(Z
z,r
f) = r -> (Z, r)
forall r. Number r => r -> (Z, r)
zFloorFraction (r -> (Z, r)) -> r -> (Z, r)
forall (h :: * -> * -> *) x y. Applicative h => h x y -> x -> y
$ r -> r
forall r. Number r => r -> r
abs r
x
zbs :: Z
zbs = N -> Z
forall a b. Embeddable a b => a -> b
inj N
base
dgtsFlr :: Z -> [N] -> [N]
dgtsFlr Z
t [N]
ds = if Z
t Z -> Z -> Bool
forall a. Eq a => a -> a -> Bool
== Z
forall r. Semiring r => r
rZero then [N]
ds else Z -> [N] -> [N]
dgtsFlr Z
z' [N]
ds'
where (Z
z',Z
zn) = Z -> Z -> (Z, Z)
forall a. Integral a => a -> a -> (a, a)
divMod Z
t Z
zbs
ds' :: [N]
ds' = Z -> N
forall a b. Projectible a b => b -> a
prj Z
zn N -> [N] -> [N]
forall a. a -> [a] -> [a]
: [N]
ds
dgtsFrc :: r -> [N]
dgtsFrc r
frc = if r
frc r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
forall r. Semiring r => r
rZero then [] else Z -> N
forall a b. Projectible a b => b -> a
prj Z
flr N -> [N] -> [N]
forall a. a -> [a] -> [a]
: r -> [N]
dgtsFrc r
frc'
where (Z
flr,r
frc') = r -> (Z, r)
forall r. Number r => r -> (Z, r)
zFloorFraction (N -> r -> r
forall a. Additive a => N -> a -> a
ntimes N
base r
frc)
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 = N -> Digits b r -> Digits b r
forall (b :: Natural) r. N -> Digits b r -> Digits b r
dgsFrcTake N
n (Digits b r -> Digits b r) -> (r -> Digits b r) -> r -> Digits b r
forall y z x. (y -> z) -> (x -> y) -> x -> z
forall (c :: * -> * -> *) y z x.
Category c =>
c y z -> c x y -> c x z
. r -> Digits b r
forall r (b :: Natural).
(Number r, KnownNat b, 2 <= b) =>
r -> Digits b r
toDigits
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 r -> r -> r
forall c. Multiplicative c => c -> c -> c
* (r -> [N] -> r -> r
forall r. Number r => r -> [N] -> r -> r
rFlr r
b' [N]
flr r
forall r. Semiring r => r
rZero r -> r -> r
forall a. Additive a => a -> a -> a
+ r -> r -> [N] -> r -> r
forall r. Number r => r -> r -> [N] -> r -> r
rFrc r
br r
br (N -> [N] -> [N]
forall a. N -> [a] -> [a]
takeN N
n [N]
frc) r
forall r. Semiring r => r
rZero) where
b :: N
b = Digits b r -> N
forall (b :: Natural) r. KnownNat b => Digits b r -> N
dgsBase Digits b r
dgs
b' :: r
b' = N -> r -> r
forall a. Additive a => N -> a -> a
ntimes N
b r
forall r. Semiring r => r
rOne
br :: r
br = r -> r
forall c. Invertible c => c -> c
invert r
b'
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 = r -> [N] -> r -> r
forall r. Number r => r -> [N] -> r -> r
rFlr r
x [N]
ds (r
x r -> r -> r
forall c. Multiplicative c => c -> c -> c
* r
r r -> r -> r
forall a. Additive a => a -> a -> a
+ N -> r -> r
forall a. Additive a => N -> a -> a
ntimes N
d r
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 = r -> r -> [N] -> r -> r
forall r. Number r => r -> r -> [N] -> r -> r
rFrc r
x r
z [N]
ds (r
r r -> r -> r
forall a. Additive a => a -> a -> a
+ r
y r -> r -> r
forall c. Multiplicative c => c -> c -> c
* N -> r -> r
forall a. Additive a => N -> a -> a
ntimes N
d r
forall r. Semiring r => r
rOne) where z :: r
z = r
xr -> r -> r
forall c. Multiplicative c => c -> c -> c
*r
y