{-# LANGUAGE RebindableSyntax #-}
{- |
Interface to "Number.Positional" which dynamically checks for equal bases.
-}
module Number.Positional.Check where

import qualified Number.Positional as Pos

import qualified Number.Complex as Complex

import qualified Algebra.RealTranscendental as RealTrans
import qualified Algebra.Transcendental     as Trans
import qualified Algebra.Algebraic          as Algebraic
import qualified Algebra.RealField          as RealField
import qualified Algebra.Field              as Field
import qualified Algebra.RealRing           as RealRing
import qualified Algebra.Absolute           as Absolute
import qualified Algebra.Ring               as Ring
import qualified Algebra.Additive           as Additive
import qualified Algebra.ZeroTestable       as ZeroTestable

import qualified Algebra.EqualityDecision as EqDec
import qualified Algebra.OrderDecision    as OrdDec

import qualified Prelude     as P98

import NumericPrelude.Base as P
import NumericPrelude.Numeric as NP


{- |
The value @Cons b e m@
represents the number @b^e * (m!!0 \/ 1 + m!!1 \/ b + m!!2 \/ b^2 + ...)@.
The interpretation of exponent is chosen such that
@floor (logBase b (Cons b e m)) == e@.
That is, it is good for multiplication and logarithms.
(Because of the necessity to normalize the multiplication result,
the alternative interpretation wouldn't be more complicated.)
However for base conversions, roots, conversion to fixed point and
working with the fractional part
the interpretation
@b^e * (m!!0 \/ b + m!!1 \/ b^2 + m!!2 \/ b^3 + ...)@
would fit better.
The digits in the mantissa range from @1-base@ to @base-1@.
The representation is not unique
and cannot be made unique in finite time.
This way we avoid infinite carry ripples.
-}
data T = Cons {T -> Basis
base :: Pos.Basis, T -> Basis
exponent :: Int, T -> Mantissa
mantissa :: Pos.Mantissa}
   deriving (Basis -> T -> ShowS
[T] -> ShowS
T -> String
(Basis -> T -> ShowS) -> (T -> String) -> ([T] -> ShowS) -> Show T
forall a.
(Basis -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [T] -> ShowS
$cshowList :: [T] -> ShowS
show :: T -> String
$cshow :: T -> String
showsPrec :: Basis -> T -> ShowS
$cshowsPrec :: Basis -> T -> ShowS
Show)


{- * basic helpers -}

{- |
Shift digits towards zero by partial application of carries.
E.g. 1.8 is converted to 2.(-2)
If the digits are in the range @(1-base, base-1)@
the resulting digits are in the range @((1-base)/2-2, (base-1)/2+2)@.
The result is still not unique,
but may be useful for further processing.
-}
compress :: T -> T
compress :: T -> T
compress = (Basis -> T -> T) -> T -> T
lift1 Basis -> T -> T
Pos.compress


{- | perfect carry resolution, works only on finite numbers -}
carry :: T -> T
carry :: T -> T
carry (Cons Basis
b Basis
ex Mantissa
xs) =
   let ys :: [(Basis, Basis)]
ys = (Basis -> (Basis, Basis) -> (Basis, Basis))
-> (Basis, Basis) -> Mantissa -> [(Basis, Basis)]
forall a b. (a -> b -> b) -> b -> [a] -> [b]
scanr (\Basis
x (Basis
c,Basis
_) -> Basis -> Basis -> (Basis, Basis)
forall a. C a => a -> a -> (a, a)
divMod (Basis
xBasis -> Basis -> Basis
forall a. C a => a -> a -> a
+Basis
c) Basis
b) (Basis
0,Basis
forall a. HasCallStack => a
undefined) Mantissa
xs
       digits :: Mantissa
digits = ((Basis, Basis) -> Basis) -> [(Basis, Basis)] -> Mantissa
forall a b. (a -> b) -> [a] -> [b]
map (Basis, Basis) -> Basis
forall a b. (a, b) -> b
snd ([(Basis, Basis)] -> [(Basis, Basis)]
forall a. [a] -> [a]
init [(Basis, Basis)]
ys)
   in  Basis -> T -> T
prependDigit ((Basis, Basis) -> Basis
forall a b. (a, b) -> a
fst ([(Basis, Basis)] -> (Basis, Basis)
forall a. [a] -> a
head [(Basis, Basis)]
ys)) (Basis -> Basis -> Mantissa -> T
Cons Basis
b Basis
ex Mantissa
digits)


prependDigit :: Pos.Digit -> T -> T
prependDigit :: Basis -> T -> T
prependDigit Basis
0 T
x = T
x
prependDigit Basis
x (Cons Basis
b Basis
ex Mantissa
xs) =
   Basis -> Basis -> Mantissa -> T
Cons Basis
b (Basis
exBasis -> Basis -> Basis
forall a. C a => a -> a -> a
+Basis
1) (Basis
xBasis -> Mantissa -> Mantissa
forall a. a -> [a] -> [a]
:Mantissa
xs)



{- * conversions -}

lift0 :: (Pos.Basis -> Pos.T) -> T
lift0 :: (Basis -> T) -> T
lift0 Basis -> T
op =
   (Basis -> Mantissa -> T) -> T -> T
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Basis -> Basis -> Mantissa -> T
Cons Basis
defltBase) (Basis -> T
op Basis
defltBase)

lift1 :: (Pos.Basis -> Pos.T -> Pos.T) -> T -> T
lift1 :: (Basis -> T -> T) -> T -> T
lift1 Basis -> T -> T
op (Cons Basis
xb Basis
xe Mantissa
xm) =
   (Basis -> Mantissa -> T) -> T -> T
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Basis -> Basis -> Mantissa -> T
Cons Basis
xb) (Basis -> T -> T
op Basis
xb (Basis
xe, Mantissa
xm))

lift2 :: (Pos.Basis -> Pos.T -> Pos.T -> Pos.T) -> T -> T -> T
lift2 :: (Basis -> T -> T -> T) -> T -> T -> T
lift2 Basis -> T -> T -> T
op (Cons Basis
xb Basis
xe Mantissa
xm) (Cons Basis
yb Basis
ye Mantissa
ym) =
   let b :: Basis
b = Basis -> Basis -> Basis
commonBasis Basis
xb Basis
yb
   in  (Basis -> Mantissa -> T) -> T -> T
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Basis -> Basis -> Mantissa -> T
Cons Basis
b) (Basis -> T -> T -> T
op Basis
b (Basis
xe, Mantissa
xm) (Basis
ye, Mantissa
ym))

{-
lift4 :: (Int -> Pos.T -> Pos.T -> Pos.T -> Pos.T -> Pos.T) -> T -> T -> T -> T -> T
lift4 op (Cons xb xe xm) (Cons yb ye ym) (Cons zb ze zm) (Cons wb we wm) =
   let b = xb `commonBasis` yb `commonBasis` zb `commonBasis` wb
   in  uncurry (Cons b) (op b (xe, xm) (ye, ym) (ze, zm) (we, wm))
-}

commonBasis :: Pos.Basis -> Pos.Basis -> Pos.Basis
commonBasis :: Basis -> Basis -> Basis
commonBasis Basis
xb Basis
yb =
   if Basis
xb Basis -> Basis -> Bool
forall a. Eq a => a -> a -> Bool
== Basis
yb
     then Basis
xb
     else String -> Basis
forall a. HasCallStack => String -> a
error String
"Number.Positional: bases differ"

fromBaseInteger :: Pos.Basis -> Integer -> T
fromBaseInteger :: Basis -> Integer -> T
fromBaseInteger Basis
b Integer
n =
   (Basis -> Mantissa -> T) -> T -> T
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Basis -> Basis -> Mantissa -> T
Cons Basis
b) (Basis -> Integer -> T
Pos.fromBaseInteger Basis
b Integer
n)

fromBaseRational :: Pos.Basis -> Rational -> T
fromBaseRational :: Basis -> Rational -> T
fromBaseRational Basis
b Rational
r =
   (Basis -> Mantissa -> T) -> T -> T
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Basis -> Basis -> Mantissa -> T
Cons Basis
b) (Basis -> Rational -> T
Pos.fromBaseRational Basis
b Rational
r)





defltBaseRoot :: Pos.Basis
defltBaseRoot :: Basis
defltBaseRoot = Basis
10

defltBaseExp :: Pos.Exponent
defltBaseExp :: Basis
defltBaseExp = Basis
3
-- exp 4   let  (sqrt 0.5) fail

defltBase :: Pos.Basis
defltBase :: Basis
defltBase = Basis -> Basis -> Basis
forall a b. (C a, C b) => b -> a -> a
ringPower Basis
defltBaseExp Basis
defltBaseRoot



defltShow :: T -> String
defltShow :: T -> String
defltShow (Cons Basis
xb Basis
xe Mantissa
xm) =
   if Basis
xb Basis -> Basis -> Bool
forall a. Eq a => a -> a -> Bool
== Basis
defltBase
     then Basis -> Basis -> T -> String
Pos.showBasis Basis
defltBaseRoot Basis
defltBaseExp (Basis
xe,Mantissa
xm)
     else ShowS
forall a. HasCallStack => String -> a
error String
"defltShow: wrong base"


instance Additive.C T where
   zero :: T
zero   = Basis -> Integer -> T
fromBaseInteger Basis
defltBase Integer
0
   + :: T -> T -> T
(+)    = (Basis -> T -> T -> T) -> T -> T -> T
lift2 Basis -> T -> T -> T
Pos.add
   (-)    = (Basis -> T -> T -> T) -> T -> T -> T
lift2 Basis -> T -> T -> T
Pos.sub
   negate :: T -> T
negate = (Basis -> T -> T) -> T -> T
lift1 Basis -> T -> T
Pos.neg

instance Ring.C T where
   one :: T
one           = Basis -> Integer -> T
fromBaseInteger Basis
defltBase Integer
1
   fromInteger :: Integer -> T
fromInteger Integer
n = Basis -> Integer -> T
fromBaseInteger Basis
defltBase Integer
n
   * :: T -> T -> T
(*)           = (Basis -> T -> T -> T) -> T -> T -> T
lift2 Basis -> T -> T -> T
Pos.mul

{-
instance Module.C T T where
   (*>) = (*)
-}

instance Field.C T where
   / :: T -> T -> T
(/)   = (Basis -> T -> T -> T) -> T -> T -> T
lift2 Basis -> T -> T -> T
Pos.divide
   recip :: T -> T
recip = (Basis -> T -> T) -> T -> T
lift1 Basis -> T -> T
Pos.reciprocal

instance Algebraic.C T where
   sqrt :: T -> T
sqrt   = (Basis -> T -> T) -> T -> T
lift1 Basis -> T -> T
Pos.sqrtNewton
   root :: Integer -> T -> T
root Integer
n = (Basis -> T -> T) -> T -> T
lift1 ((Basis -> Integer -> T -> T) -> Integer -> Basis -> T -> T
forall a b c. (a -> b -> c) -> b -> a -> c
flip Basis -> Integer -> T -> T
Pos.root Integer
n)
   T
x ^/ :: T -> Rational -> T
^/ Rational
y = (Basis -> T -> T) -> T -> T
lift1 ((Basis -> Rational -> T -> T) -> Rational -> Basis -> T -> T
forall a b c. (a -> b -> c) -> b -> a -> c
flip Basis -> Rational -> T -> T
Pos.power Rational
y) T
x

instance Trans.C T where
   pi :: T
pi     = (Basis -> T) -> T
lift0 Basis -> T
Pos.piConst

   exp :: T -> T
exp    = (Basis -> T -> T) -> T -> T
lift1 Basis -> T -> T
Pos.exp
   log :: T -> T
log    = (Basis -> T -> T) -> T -> T
lift1 Basis -> T -> T
Pos.ln

   sin :: T -> T
sin    = (Basis -> T -> T) -> T -> T
lift1 (\Basis
b -> (T, T) -> T
forall a b. (a, b) -> b
snd ((T, T) -> T) -> (T -> (T, T)) -> T -> T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Basis -> T -> (T, T)
Pos.cosSin Basis
b)
   cos :: T -> T
cos    = (Basis -> T -> T) -> T -> T
lift1 (\Basis
b -> (T, T) -> T
forall a b. (a, b) -> a
fst ((T, T) -> T) -> (T -> (T, T)) -> T -> T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Basis -> T -> (T, T)
Pos.cosSin Basis
b)
   tan :: T -> T
tan    = (Basis -> T -> T) -> T -> T
lift1 Basis -> T -> T
Pos.tan

   atan :: T -> T
atan   = (Basis -> T -> T) -> T -> T
lift1 Basis -> T -> T
Pos.arctan

   {-
   sinh   = lift1 (\b -> snd . Pos.cosSinh b)
   cosh   = lift1 (\b -> snd . Pos.cosSinh b)
   -}

{-
The way EqDec and OrdDec are instantiated
it is possible to have different bases
for the arguments for comparison
and the arguments between we decide.
However, I would not rely on this.
-}
instance EqDec.C T where
   T
x==? :: T -> T -> T -> T -> T
==?T
y  =  (Basis -> T -> T -> T) -> T -> T -> T
lift2 (\Basis
b -> Basis -> Bool -> T -> T -> T
Pos.ifLazy Basis
b (T
xT -> T -> Bool
forall a. Eq a => a -> a -> Bool
==T
y))

instance OrdDec.C T where
   T
x<=? :: T -> T -> T -> T -> T
<=?T
y  =  (Basis -> T -> T -> T) -> T -> T -> T
lift2 (\Basis
b -> Basis -> Bool -> T -> T -> T
Pos.ifLazy Basis
b (T
xT -> T -> Bool
forall a. Ord a => a -> a -> Bool
<=T
y))

instance ZeroTestable.C T where
   isZero :: T -> Bool
isZero (Cons Basis
xb Basis
xe Mantissa
xm) =
      Basis -> T -> T -> Ordering
Pos.cmp Basis
xb (Basis
xe,Mantissa
xm) T
Pos.zero Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance Eq T where
   (Cons Basis
xb Basis
xe Mantissa
xm) == :: T -> T -> Bool
== (Cons Basis
yb Basis
ye Mantissa
ym) =
      Basis -> T -> T -> Ordering
Pos.cmp (Basis -> Basis -> Basis
commonBasis Basis
xb Basis
yb) (Basis
xe,Mantissa
xm) (Basis
ye,Mantissa
ym) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ

instance Ord T where
   compare :: T -> T -> Ordering
compare (Cons Basis
xb Basis
xe Mantissa
xm) (Cons Basis
yb Basis
ye Mantissa
ym) =
      Basis -> T -> T -> Ordering
Pos.cmp (Basis -> Basis -> Basis
commonBasis Basis
xb Basis
yb) (Basis
xe,Mantissa
xm) (Basis
ye,Mantissa
ym)

instance Absolute.C T where
   abs :: T -> T
abs = (Basis -> T -> T) -> T -> T
lift1 ((T -> T) -> Basis -> T -> T
forall a b. a -> b -> a
const T -> T
Pos.absolute)
   signum :: T -> T
signum = T -> T
forall a. (C a, Ord a) => a -> a
Absolute.signumOrd

instance RealRing.C T where
   splitFraction :: T -> (b, T)
splitFraction (Cons Basis
xb Basis
xe Mantissa
xm) =
      let (Integer
int, Mantissa
frac) = Basis -> T -> (Integer, Mantissa)
Pos.toFixedPoint Basis
xb (Basis
xe,Mantissa
xm)
      in  (Integer -> b
forall a. C a => Integer -> a
fromInteger Integer
int, Basis -> Basis -> Mantissa -> T
Cons Basis
xb (-Basis
1) Mantissa
frac)

instance RealField.C T where

instance RealTrans.C T where
   atan2 :: T -> T -> T
atan2  = (Basis -> T -> T -> T) -> T -> T -> T
lift2 (((T, T) -> T) -> T -> T -> T
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((T, T) -> T) -> T -> T -> T)
-> (Basis -> (T, T) -> T) -> Basis -> T -> T -> T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Basis -> (T, T) -> T
Pos.angle)


-- for complex numbers

instance Complex.Power T where
   power :: Rational -> T T -> T T
power     = Rational -> T T -> T T
forall a. (C a, C a) => Rational -> T a -> T a
Complex.defltPow




-- legacy instances for use of numeric literals in GHCi
instance P98.Num T where
   fromInteger :: Integer -> T
fromInteger = Basis -> Integer -> T
fromBaseInteger Basis
defltBase
   negate :: T -> T
negate = T -> T
forall a. C a => a -> a
negate -- for unary minus
   + :: T -> T -> T
(+)    = T -> T -> T
forall a. C a => a -> a -> a
(+)
   * :: T -> T -> T
(*)    = T -> T -> T
forall a. C a => a -> a -> a
(*)
   abs :: T -> T
abs    = T -> T
forall a. C a => a -> a
abs
   signum :: T -> T
signum = T -> T
forall a. C a => a -> a
signum

instance P98.Fractional T where
   fromRational :: Rational -> T
fromRational = Basis -> Rational -> T
fromBaseRational Basis
defltBase (Rational -> T) -> (Rational -> Rational) -> Rational -> T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational
forall a. C a => Rational -> a
fromRational
   / :: T -> T -> T
(/) = T -> T -> T
forall a. C a => a -> a -> a
(/)


{-
MathObj.PowerSeries.approx MathObj.PowerSeries.Example.exp (Number.Positional.fromBaseInteger 10 1) List.!! 30 :: Number.Positional.Check.T
-}