{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-|
    Module      :  AERN2.MP.WithCurrentPrec.Elementary
    Description :  WithCurrentPrec elementary operations
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mikkonecny@gmail.com
    Stability   :  experimental
    Portability :  portable

    WithCurrentPrec elementary operations
-}
module AERN2.MP.WithCurrentPrec.Elementary
(   
    piCP
    , _example1 , _example2 , _example3
)
where

import MixedTypesNumPrelude
-- import qualified Prelude as P
-- import Text.Printf

import GHC.TypeLits ( KnownNat )

-- import qualified Numeric.CollectErrors as CN

import AERN2.MP.Ball

import AERN2.MP.WithCurrentPrec.Type

import AERN2.MP.WithCurrentPrec.Field ()

piCP :: (KnownNat p) => WithCurrentPrec p (CN MPBall)
piCP :: WithCurrentPrec p (CN MPBall)
piCP = WithCurrentPrec p (CN MPBall)
r 
    where
    r :: WithCurrentPrec p (CN MPBall)
r = CN MPBall -> WithCurrentPrec p (CN MPBall)
forall k (p :: k) t. t -> WithCurrentPrec p t
WithCurrentPrec (CN MPBall -> WithCurrentPrec p (CN MPBall))
-> CN MPBall -> WithCurrentPrec p (CN MPBall)
forall a b. (a -> b) -> a -> b
$ MPBall -> CN MPBall
forall v. v -> CN v
cn (MPBall -> CN MPBall) -> MPBall -> CN MPBall
forall a b. (a -> b) -> a -> b
$ Precision -> MPBall
piBallP (WithCurrentPrec p (CN MPBall) -> Precision
forall (p :: Nat) t. KnownNat p => WithCurrentPrec p t -> Precision
getCurrentPrecision WithCurrentPrec p (CN MPBall)
r)

instance
    (CanSinCos t)
    =>
    CanSinCos (WithCurrentPrec p t)
    where
    type SinCosType (WithCurrentPrec p t) = WithCurrentPrec p (SinCosType t)
    sin :: WithCurrentPrec p t -> SinCosType (WithCurrentPrec p t)
sin = (t -> SinCosType t)
-> WithCurrentPrec p t -> WithCurrentPrec p (SinCosType t)
forall k t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
sin
    cos :: WithCurrentPrec p t -> SinCosType (WithCurrentPrec p t)
cos = (t -> SinCosType t)
-> WithCurrentPrec p t -> WithCurrentPrec p (SinCosType t)
forall k t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 t -> SinCosType t
forall t. CanSinCos t => t -> SinCosType t
cos

instance
    (CanSqrt t)
    =>
    CanSqrt (WithCurrentPrec p t)
    where
    type SqrtType (WithCurrentPrec p t) = WithCurrentPrec p (SqrtType t)
    sqrt :: WithCurrentPrec p t -> SqrtType (WithCurrentPrec p t)
sqrt = (t -> SqrtType t)
-> WithCurrentPrec p t -> WithCurrentPrec p (SqrtType t)
forall k t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 t -> SqrtType t
forall t. CanSqrt t => t -> SqrtType t
sqrt

instance
    (CanExp t)
    =>
    CanExp (WithCurrentPrec p t)
    where
    type ExpType (WithCurrentPrec p t) = WithCurrentPrec p (ExpType t)
    exp :: WithCurrentPrec p t -> ExpType (WithCurrentPrec p t)
exp = (t -> ExpType t)
-> WithCurrentPrec p t -> WithCurrentPrec p (ExpType t)
forall k t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 t -> ExpType t
forall t. CanExp t => t -> ExpType t
exp

instance
    (CanLog t)
    =>
    CanLog (WithCurrentPrec p t)
    where
    type LogType (WithCurrentPrec p t) = WithCurrentPrec p (LogType t)
    log :: WithCurrentPrec p t -> LogType (WithCurrentPrec p t)
log = (t -> LogType t)
-> WithCurrentPrec p t -> WithCurrentPrec p (LogType t)
forall k t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 t -> LogType t
forall t. CanLog t => t -> LogType t
log

instance
    (CanPow t1 t2, p1~p2)
    =>
    (CanPow (WithCurrentPrec p1 t1) (WithCurrentPrec p2 t2)) where
    type PowType (WithCurrentPrec p1 t1) (WithCurrentPrec p2 t2) = WithCurrentPrec p1 (PowType t1 t2)
    pow :: WithCurrentPrec p1 t1
-> WithCurrentPrec p2 t2
-> PowType (WithCurrentPrec p1 t1) (WithCurrentPrec p2 t2)
pow = (t1 -> t2 -> PowType t1 t2)
-> WithCurrentPrec p1 t1
-> WithCurrentPrec p2 t2
-> WithCurrentPrec p1 (PowType t1 t2)
forall k (p1 :: k) (p2 :: k) t1 t2 t3.
(p1 ~ p2) =>
(t1 -> t2 -> t3)
-> WithCurrentPrec p1 t1
-> WithCurrentPrec p2 t2
-> WithCurrentPrec p1 t3
lift2 t1 -> t2 -> PowType t1 t2
forall b e. CanPow b e => b -> e -> PowType b e
pow

$(declForTypes
  [[t| Integer |], [t| Int |], [t| Rational |]]
  (\ e -> [d|

  instance 
    (CanPow b $e)
    =>
    CanPow (WithCurrentPrec p b) $e 
    where
    type PowType (WithCurrentPrec p b) $e = WithCurrentPrec p (PowType b $e)
    pow = lift1T pow

  |]))

$(declForTypes
  [[t| Integer |], [t| Int |], [t| Rational |]]
  (\ b -> [d|

  instance 
    (CanPow $b e, HasOrderCertainly e Integer, CanTestInteger e)
    =>
    CanPow $b (WithCurrentPrec p e) 
    where
    type PowType $b (WithCurrentPrec p e) = WithCurrentPrec p (PowType $b e)
    pow = liftT1 pow
  |]))

_example1 :: CN MPBall
_example1 :: CN MPBall
_example1 = Precision
-> (forall (p :: Nat). KnownNat p => WithCurrentPrec p (CN MPBall))
-> CN MPBall
forall t.
Precision
-> (forall (p :: Nat). KnownNat p => WithCurrentPrec p t) -> t
runWithPrec (Integer -> Precision
prec Integer
1000) forall (p :: Nat). KnownNat p => WithCurrentPrec p (CN MPBall)
piCP

_example2 :: CN MPBall
_example2 :: CN MPBall
_example2 = Precision
-> (forall (p :: Nat). KnownNat p => WithCurrentPrec p (CN MPBall))
-> CN MPBall
forall t.
Precision
-> (forall (p :: Nat). KnownNat p => WithCurrentPrec p t) -> t
runWithPrec (Integer -> Precision
prec Integer
1000) ((forall (p :: Nat). KnownNat p => WithCurrentPrec p (CN MPBall))
 -> CN MPBall)
-> (forall (p :: Nat). KnownNat p => WithCurrentPrec p (CN MPBall))
-> CN MPBall
forall a b. (a -> b) -> a -> b
$ WithCurrentPrec p (CN MPBall)
forall (p :: Nat). KnownNat p => WithCurrentPrec p (CN MPBall)
piCP WithCurrentPrec p (CN MPBall)
-> WithCurrentPrec p (CN MPBall)
-> SubType
     (WithCurrentPrec p (CN MPBall)) (WithCurrentPrec p (CN MPBall))
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- WithCurrentPrec p (CN MPBall)
forall (p :: Nat). KnownNat p => WithCurrentPrec p (CN MPBall)
piCP

_example3 :: CN MPBall
_example3 :: CN MPBall
_example3 = Precision
-> (forall (p :: Nat). KnownNat p => WithCurrentPrec p (CN MPBall))
-> CN MPBall
forall t.
Precision
-> (forall (p :: Nat). KnownNat p => WithCurrentPrec p t) -> t
runWithPrec (Integer -> Precision
prec Integer
1000) ((forall (p :: Nat). KnownNat p => WithCurrentPrec p (CN MPBall))
 -> CN MPBall)
-> (forall (p :: Nat). KnownNat p => WithCurrentPrec p (CN MPBall))
-> CN MPBall
forall a b. (a -> b) -> a -> b
$ WithCurrentPrec p (CN MPBall)
-> SqrtType (WithCurrentPrec p (CN MPBall))
forall t. CanSqrt t => t -> SqrtType t
sqrt (Integer -> WithCurrentPrec p (CN MPBall)
forall t (p :: Nat).
(CanBeMPBallP t, KnownNat p) =>
t -> WithCurrentPrec p (CN MPBall)
cnmpBallCP Integer
2)