{-# LANGUAGE NoImplicitPrelude #-}
{- |
Copyright   :  (c) Henning Thielemann 2006
License     :  GPL

Maintainer  :  numericprelude@henning-thielemann.de
Stability   :  provisional


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.Module             as Module
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.Real               as Real
import qualified Algebra.Ring               as Ring
import qualified Algebra.Additive           as Additive
import qualified Algebra.ZeroTestable       as ZeroTestable

import qualified PreludeBase as P
import qualified Prelude     as P98

import PreludeBase as P
import NumericPrelude 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 {base :: Int, exponent :: Int, mantissa :: Pos.Mantissa}
   deriving (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 = lift1 Pos.compress


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


prependDigit :: Int -> T -> T
prependDigit 0 x = x
prependDigit x (Cons b ex xs) =
   Cons b (ex+1) (x:xs)



{- * conversions -}

lift0 :: (Int -> Pos.T) -> T
lift0 op =
   uncurry (Cons defltBase) (op defltBase)

lift1 :: (Int -> Pos.T -> Pos.T) -> T -> T
lift1 op (Cons xb xe xm) =
   uncurry (Cons xb) (op xb (xe, xm))

lift2 :: (Int -> Pos.T -> Pos.T -> Pos.T) -> T -> T -> T
lift2 op (Cons xb xe xm) (Cons yb ye ym) =
   let zb = commonBasis xb yb
   in  uncurry (Cons zb) (op xb (xe, xm) (ye, ym))

commonBasis :: Pos.Basis -> Pos.Basis -> Pos.Basis
commonBasis xb yb =
   if xb == yb
     then xb
     else error "Number.Positional: bases differ"

fromBaseInteger :: Int -> Integer -> T
fromBaseInteger b n =
   uncurry (Cons b) (Pos.fromBaseInteger b n)

fromBaseRational :: Int -> Rational -> T
fromBaseRational b r =
   uncurry (Cons b) (Pos.fromBaseRational b r)





defltBaseRoot :: Pos.Basis
defltBaseRoot = 10

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

defltBase :: Pos.Basis
defltBase = ringPower defltBaseExp defltBaseRoot



defltShow :: T -> String
defltShow (Cons xb xe xm) =
   if xb == defltBase
     then Pos.showBasis defltBaseRoot defltBaseExp (xe,xm)
     else error "defltShow: wrong base"


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

instance Ring.C T where
   one           = fromBaseInteger defltBase 1
   fromInteger n = fromBaseInteger defltBase n
   (*)           = lift2 Pos.mul

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

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

instance Algebraic.C T where
   sqrt   = lift1 Pos.sqrtNewton
   root n = lift1 (flip Pos.root n)
   x ^/ y = lift1 (flip Pos.power y) x

instance Trans.C T where
   pi     = lift0 Pos.piConst

   exp    = lift1 Pos.exp
   log    = lift1 Pos.ln

   sin    = lift1 (\b -> snd . Pos.cosSin b)
   cos    = lift1 (\b -> fst . Pos.cosSin b)
   tan    = lift1 Pos.tan

   atan   = lift1 Pos.arctan

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

instance ZeroTestable.C T where
   isZero (Cons xb xe xm) =
      Pos.cmp xb (xe,xm) Pos.zero == EQ

instance Eq T where
   (Cons xb xe xm) == (Cons yb ye ym) =
      Pos.cmp (commonBasis xb yb) (xe,xm) (ye,ym) == EQ

instance Ord T where
   compare (Cons xb xe xm) (Cons yb ye ym) =
      Pos.cmp (commonBasis xb yb) (xe,xm) (ye,ym)

instance Real.C T where
   abs = lift1 (const Pos.absolute)
   -- use default implementation for signum

instance RealField.C T where
   splitFraction (Cons xb xe xm) =
      let (int, frac) = Pos.toFixedPoint xb (xe,xm)
      in  (fromInteger int, Cons xb (-1) frac)

instance RealTrans.C T where
   atan2  = lift2 (curry . Pos.angle)


-- for complex numbers

instance Complex.Power T where
   power     = Complex.defltPow




-- legacy instances for work with GHCi
legacyInstance :: a
legacyInstance =
   error "legacy Ring.C instance for simple input of numeric literals"

instance P98.Num T where
   fromInteger = fromBaseInteger defltBase
   negate = negate --for unary minus
   (+)    = legacyInstance
   (*)    = legacyInstance
   abs    = legacyInstance
   signum = legacyInstance

instance P98.Fractional T where
   fromRational = fromBaseRational defltBase . fromRational
   (/) = legacyInstance


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