{-# LANGUAGE CPP #-}
-- #define DEBUG
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-|
    Module      :  AERN2.MP.Dyadic
    Description :  Dyadics with exact ring operations
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

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

    Arbitrary precision floating-point numbers with exact ring operations.

    Currently, we use hmpfr when compiling with ghc 7.10 and higher
    and haskell-mpfr when compiling with ghc 7.8.
-}
module AERN2.MP.Dyadic
(
   -- * Dyadic numbers and their basic operations
   Dyadic, HasDyadics
   -- * Dyadic constructors
   , CanBeDyadic, dyadic
   -- * tests
   , specDyadic, tDyadic
)
where

#ifdef DEBUG
import Debug.Trace (trace)
#define maybeTrace trace
#define maybeTraceIO putStrLn
#else
#define maybeTrace (\ (_ :: String) t -> t)
#define maybeTraceIO (\ (_ :: String) -> return ())
#endif

import MixedTypesNumPrelude
import qualified Prelude as P

import Control.CollectErrors (CollectErrors(..), CanBeErrors)
import qualified Control.CollectErrors as CE
-- import qualified Numeric.CollectErrors as CN

import Text.Printf
import Text.Regex.TDFA

import Data.Typeable
-- import Data.Convertible

import Test.Hspec
import Test.QuickCheck
-- import qualified Test.Hspec.SmallCheck as SC

import Data.Ratio (denominator, numerator)

import Math.NumberTheory.Logarithms (integerLog2)

import AERN2.Norm
import AERN2.MP.Precision
import AERN2.MP.Accuracy
import AERN2.MP.Float hiding (lift1, lift2)

{-| Exact dyadic type based on MPFloat. -}
newtype Dyadic = Dyadic { Dyadic -> MPFloat
dyadicMPFloat :: MPFloat }
  deriving (Dyadic -> Dyadic -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dyadic -> Dyadic -> Bool
$c/= :: Dyadic -> Dyadic -> Bool
== :: Dyadic -> Dyadic -> Bool
$c== :: Dyadic -> Dyadic -> Bool
P.Eq, Eq Dyadic
Dyadic -> Dyadic -> Bool
Dyadic -> Dyadic -> Ordering
Dyadic -> Dyadic -> Dyadic
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Dyadic -> Dyadic -> Dyadic
$cmin :: Dyadic -> Dyadic -> Dyadic
max :: Dyadic -> Dyadic -> Dyadic
$cmax :: Dyadic -> Dyadic -> Dyadic
>= :: Dyadic -> Dyadic -> Bool
$c>= :: Dyadic -> Dyadic -> Bool
> :: Dyadic -> Dyadic -> Bool
$c> :: Dyadic -> Dyadic -> Bool
<= :: Dyadic -> Dyadic -> Bool
$c<= :: Dyadic -> Dyadic -> Bool
< :: Dyadic -> Dyadic -> Bool
$c< :: Dyadic -> Dyadic -> Bool
compare :: Dyadic -> Dyadic -> Ordering
$ccompare :: Dyadic -> Dyadic -> Ordering
P.Ord, Dyadic -> (RoundType Dyadic, Dyadic)
Dyadic -> RoundType Dyadic
forall t.
(t -> (RoundType t, t))
-> (t -> RoundType t)
-> (t -> RoundType t)
-> (t -> RoundType t)
-> (t -> RoundType t)
-> CanRound t
floor :: Dyadic -> RoundType Dyadic
$cfloor :: Dyadic -> RoundType Dyadic
ceiling :: Dyadic -> RoundType Dyadic
$cceiling :: Dyadic -> RoundType Dyadic
round :: Dyadic -> RoundType Dyadic
$cround :: Dyadic -> RoundType Dyadic
truncate :: Dyadic -> RoundType Dyadic
$ctruncate :: Dyadic -> RoundType Dyadic
properFraction :: Dyadic -> (RoundType Dyadic, Dyadic)
$cproperFraction :: Dyadic -> (RoundType Dyadic, Dyadic)
CanRound, Dyadic -> Precision
forall t. (t -> Precision) -> HasPrecision t
getPrecision :: Dyadic -> Precision
$cgetPrecision :: Dyadic -> Precision
HasPrecision, Dyadic -> NormLog
forall a. (a -> NormLog) -> HasNorm a
getNormLog :: Dyadic -> NormLog
$cgetNormLog :: Dyadic -> NormLog
HasNorm, Typeable)

instance Ring Dyadic
instance Ring (CN Dyadic)

instance OrderedRing Dyadic
instance OrderedRing (CN Dyadic)

instance OrderedCertainlyRing Dyadic
instance OrderedCertainlyRing (CN Dyadic)

instance HasAccuracy Dyadic where getAccuracy :: Dyadic -> Accuracy
getAccuracy Dyadic
_ = Accuracy
Exact
instance CanGiveUpIfVeryInaccurate Dyadic -- ie, never give up

instance Show Dyadic where
  show :: Dyadic -> String
show (Dyadic MPFloat
x)
    | Integer
e forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
0 = forall r. PrintfType r => String -> r
printf String
"dyadic (%d)" Integer
n
    | Integer
e forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Integer
0 = forall r. PrintfType r => String -> r
printf String
"dyadic (%d*0.5^%d)" Integer
n Integer
e
    | Bool
otherwise = forall a. HasCallStack => String -> a
error String
"in show Dyadic"
    where
    xR :: Rational
xR = forall t. CanBeRational t => t -> Rational
rational MPFloat
x
    NormBits Integer
e = forall a. HasNorm a => a -> NormLog
getNormLog (forall a. Ratio a -> a
denominator Rational
xR)
    n :: Integer
n = forall a. Ratio a -> a
numerator Rational
xR

instance Read Dyadic where
  readsPrec :: Int -> ReadS Dyadic
readsPrec Int
_pr String
dyadicS =
    [(Dyadic, String)] -> [(Dyadic, String)]
tryInt forall a b. (a -> b) -> a -> b
$ [(Dyadic, String)] -> [(Dyadic, String)]
tryWithExp []
    where
    tryInt :: [(Dyadic, String)] -> [(Dyadic, String)]
tryInt [(Dyadic, String)]
tryNext =
      case [String]
groups of
        [String
nS] ->
          case forall a. Read a => ReadS a
reads String
nS of
            [(Integer
n,String
"")] -> [(forall t. CanBeDyadic t => t -> Dyadic
dyadic (Integer
n :: Integer), String
afterS)]
            [(Integer, String)]
_ -> [(Dyadic, String)]
tryNext
        [String]
_ -> [(Dyadic, String)]
tryNext
      where
      (String
_,String
_,String
afterS,[String]
groups) =
        String
dyadicS forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"\\`dyadic \\(([-0-9]*)\\)"
          :: (String, String, String, [String])
    tryWithExp :: [(Dyadic, String)] -> [(Dyadic, String)]
tryWithExp [(Dyadic, String)]
tryNext =
      case [String]
groups of
        [String
nS,String
eS] ->
          case (forall a. Read a => ReadS a
reads String
nS, forall a. Read a => ReadS a
reads String
eS) of
            ([(Integer
n,String
"")],[(Integer
e,String
"")]) ->
              [((Integer
n :: Integer)forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*(forall t. CanBeDyadic t => t -> Dyadic
dyadic Rational
0.5)forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^(Integer
e :: Integer), String
afterS)]
            ([(Integer, String)], [(Integer, String)])
_ -> [(Dyadic, String)]
tryNext
        [String]
_ -> [(Dyadic, String)]
tryNext
      where
      (String
_,String
_,String
afterS,[String]
groups) =
        String
dyadicS forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"\\`dyadic \\(([-0-9]*)\\*0.5\\^([0-9]*)\\)"
          :: (String, String, String, [String])


{-- conversions --}

type HasDyadics t = ConvertibleExactly Dyadic t

instance ConvertibleExactly Dyadic Dyadic where
  safeConvertExactly :: Dyadic -> ConvertResult Dyadic
safeConvertExactly = forall a b. b -> Either a b
Right

instance ConvertibleExactly Dyadic MPFloat where
  safeConvertExactly :: Dyadic -> ConvertResult MPFloat
safeConvertExactly = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dyadic -> MPFloat
dyadicMPFloat

instance ConvertibleExactly Dyadic Rational where
  safeConvertExactly :: Dyadic -> ConvertResult Rational
safeConvertExactly = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> ConvertResult t2
safeConvertExactly forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dyadic -> MPFloat
dyadicMPFloat

type CanBeDyadic t = ConvertibleExactly t Dyadic
dyadic :: (CanBeDyadic t) => t -> Dyadic
dyadic :: forall t. CanBeDyadic t => t -> Dyadic
dyadic = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly

instance ConvertibleExactly MPFloat Dyadic where
  safeConvertExactly :: MPFloat -> ConvertResult Dyadic
safeConvertExactly = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPFloat -> Dyadic
Dyadic

instance HasIntegerBounds Dyadic where
  integerBounds :: Dyadic -> (Integer, Integer)
integerBounds Dyadic
d = (forall t. CanRound t => t -> RoundType t
floor Dyadic
d, forall t. CanRound t => t -> RoundType t
ceiling Dyadic
d)

instance ConvertibleExactly Integer Dyadic where
  safeConvertExactly :: Integer -> ConvertResult Dyadic
safeConvertExactly = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MPFloat -> Dyadic
Dyadic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t1 t2. ConvertibleExactly t1 t2 => t1 -> ConvertResult t2
safeConvertExactly

instance ConvertibleExactly Int Dyadic where
  safeConvertExactly :: Int -> ConvertResult Dyadic
safeConvertExactly = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MPFloat -> Dyadic
Dyadic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t1 t2. ConvertibleExactly t1 t2 => t1 -> ConvertResult t2
safeConvertExactly

instance ConvertibleExactly Rational Dyadic where
  safeConvertExactly :: Rational -> ConvertResult Dyadic
safeConvertExactly Rational
q
    | EqCompareType Integer Integer
isDyadic = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ MPFloat -> Dyadic
Dyadic (forall a. BoundsCEDU a -> a
ceduCentre forall a b. (a -> b) -> a -> b
$ Precision -> Rational -> BoundsCEDU MPFloat
fromRationalCEDU (Integer -> Precision
prec forall a b. (a -> b) -> a -> b
$ forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max Integer
2 (Int
dp forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Int
np forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
1)) Rational
q)
    | Bool
otherwise = forall a b.
(Show a, Typeable a, Typeable b) =>
String -> a -> ConvertResult b
convError String
"this number is not dyadic" Rational
q
    where
    isDyadic :: EqCompareType Integer Integer
isDyadic = Integer
d forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
2forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
^Int
dp
    dp :: Int
dp = Integer -> Int
integerLog2 Integer
d
    d :: Integer
d = forall a. Ratio a -> a
denominator Rational
q
    np :: Int
np = Integer -> Int
integerLog2 (forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max Integer
1 forall a b. (a -> b) -> a -> b
$ forall t. CanAbs t => t -> AbsType t
abs forall a b. (a -> b) -> a -> b
$ forall a. Ratio a -> a
numerator Rational
q)

instance Convertible Dyadic Double where
  safeConvert :: Dyadic -> ConvertResult Double
safeConvert = forall a b. Convertible a b => a -> ConvertResult b
safeConvert forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dyadic -> MPFloat
dyadicMPFloat

instance (ConvertibleExactly Dyadic t, Monoid es) => ConvertibleExactly Dyadic (CollectErrors es t) where
  safeConvertExactly :: Dyadic -> ConvertResult (CollectErrors es t)
safeConvertExactly = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t
v -> forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors (forall a. a -> Maybe a
Just t
v) forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t1 t2. ConvertibleExactly t1 t2 => t1 -> ConvertResult t2
safeConvertExactly

{-- comparisons --}

instance HasEqAsymmetric Dyadic Dyadic
instance HasEqAsymmetric Dyadic Integer where
  equalTo :: Dyadic -> Integer -> EqCompareType Dyadic Integer
equalTo = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo
instance HasEqAsymmetric Integer Dyadic where
  equalTo :: Integer -> Dyadic -> EqCompareType Integer Dyadic
equalTo = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo
instance HasEqAsymmetric Dyadic Int where
  equalTo :: Dyadic -> Int -> EqCompareType Dyadic Int
equalTo = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo
instance HasEqAsymmetric Int Dyadic where
  equalTo :: Int -> Dyadic -> EqCompareType Int Dyadic
equalTo = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo
instance HasEqAsymmetric Dyadic Rational where
  equalTo :: Dyadic -> Rational -> EqCompareType Dyadic Rational
equalTo = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo
instance HasEqAsymmetric Rational Dyadic where
  equalTo :: Rational -> Dyadic -> EqCompareType Rational Dyadic
equalTo = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo

instance
  (HasEqAsymmetric Dyadic b
  , IsBool (CollectErrors es (EqCompareType Dyadic b))
  , CanBeErrors es)
  =>
  HasEqAsymmetric Dyadic (CollectErrors es b)
  where
  type EqCompareType Dyadic (CollectErrors es b) =
    CollectErrors es (EqCompareType Dyadic b)
  equalTo :: Dyadic
-> CollectErrors es b -> EqCompareType Dyadic (CollectErrors es b)
equalTo = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo

instance
  (HasEqAsymmetric a Dyadic
  , IsBool (CollectErrors es (EqCompareType a Dyadic))
  , CanBeErrors es)
  =>
  HasEqAsymmetric (CollectErrors es a) Dyadic
  where
  type EqCompareType (CollectErrors es  a) Dyadic =
    CollectErrors es (EqCompareType a Dyadic)
  equalTo :: CollectErrors es a
-> Dyadic -> EqCompareType (CollectErrors es a) Dyadic
equalTo = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo

instance CanTestZero Dyadic

instance HasOrderAsymmetric Dyadic Dyadic
instance HasOrderAsymmetric Dyadic Integer where
  lessThan :: Dyadic -> Integer -> OrderCompareType Dyadic Integer
lessThan = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: Dyadic -> Integer -> OrderCompareType Dyadic Integer
leq = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq
instance HasOrderAsymmetric Integer Dyadic where
  lessThan :: Integer -> Dyadic -> OrderCompareType Integer Dyadic
lessThan = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: Integer -> Dyadic -> OrderCompareType Integer Dyadic
leq = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq
instance HasOrderAsymmetric Dyadic Int where
  lessThan :: Dyadic -> Int -> OrderCompareType Dyadic Int
lessThan = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: Dyadic -> Int -> OrderCompareType Dyadic Int
leq = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq
instance HasOrderAsymmetric Int Dyadic where
  lessThan :: Int -> Dyadic -> OrderCompareType Int Dyadic
lessThan = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: Int -> Dyadic -> OrderCompareType Int Dyadic
leq = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq
instance HasOrderAsymmetric Rational Dyadic where
  lessThan :: Rational -> Dyadic -> OrderCompareType Rational Dyadic
lessThan = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: Rational -> Dyadic -> OrderCompareType Rational Dyadic
leq = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq
instance HasOrderAsymmetric Dyadic Rational where
  lessThan :: Dyadic -> Rational -> OrderCompareType Dyadic Rational
lessThan = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: Dyadic -> Rational -> OrderCompareType Dyadic Rational
leq = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq

instance
  (HasOrderAsymmetric Dyadic b
  , IsBool (CollectErrors es (OrderCompareType Dyadic b))
  , CanBeErrors es)
  =>
  HasOrderAsymmetric Dyadic (CollectErrors es  b)
  where
  type OrderCompareType Dyadic (CollectErrors es  b) =
    CollectErrors es (OrderCompareType Dyadic b)
  lessThan :: Dyadic
-> CollectErrors es b
-> OrderCompareType Dyadic (CollectErrors es b)
lessThan = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: Dyadic
-> CollectErrors es b
-> OrderCompareType Dyadic (CollectErrors es b)
leq = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq
  greaterThan :: Dyadic
-> CollectErrors es b
-> OrderCompareType Dyadic (CollectErrors es b)
greaterThan = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
greaterThan
  geq :: Dyadic
-> CollectErrors es b
-> OrderCompareType Dyadic (CollectErrors es b)
geq = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
geq

instance
  (HasOrderAsymmetric a Dyadic
  , IsBool (CollectErrors es (OrderCompareType a Dyadic))
  , CanBeErrors es)
  =>
  HasOrderAsymmetric (CollectErrors es a) Dyadic
  where
  type OrderCompareType (CollectErrors es  a) Dyadic =
    CollectErrors es (OrderCompareType a Dyadic)
  lessThan :: CollectErrors es a
-> Dyadic -> OrderCompareType (CollectErrors es a) Dyadic
lessThan = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan
  leq :: CollectErrors es a
-> Dyadic -> OrderCompareType (CollectErrors es a) Dyadic
leq = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq
  greaterThan :: CollectErrors es a
-> Dyadic -> OrderCompareType (CollectErrors es a) Dyadic
greaterThan = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
greaterThan
  geq :: CollectErrors es a
-> Dyadic -> OrderCompareType (CollectErrors es a) Dyadic
geq = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
geq


instance CanTestPosNeg Dyadic

instance CanTestInteger Dyadic where
  certainlyNotInteger :: Dyadic -> Bool
certainlyNotInteger = forall t. CanTestInteger t => t -> Bool
certainlyNotInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. CanBeRational t => t -> Rational
rational
  certainlyIntegerGetIt :: Dyadic -> Maybe Integer
certainlyIntegerGetIt = forall t. CanTestInteger t => t -> Maybe Integer
certainlyIntegerGetIt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. CanBeRational t => t -> Rational
rational

{- unary functions -}

instance CanNeg Dyadic where
  negate :: Dyadic -> NegType Dyadic
negate = (MPFloat -> MPFloat) -> Dyadic -> Dyadic
lift1 forall t. CanNeg t => t -> NegType t
negate

instance CanAbs Dyadic where
  abs :: Dyadic -> AbsType Dyadic
abs = (MPFloat -> MPFloat) -> Dyadic -> Dyadic
lift1 forall t. CanAbs t => t -> AbsType t
abs

lift1 :: (MPFloat -> MPFloat) -> (Dyadic -> Dyadic)
lift1 :: (MPFloat -> MPFloat) -> Dyadic -> Dyadic
lift1 MPFloat -> MPFloat
op (Dyadic MPFloat
x) = MPFloat -> Dyadic
Dyadic (MPFloat -> MPFloat
op MPFloat
x)

{- min/max -}

instance CanMinMaxAsymmetric Dyadic Dyadic
instance CanMinMaxAsymmetric Integer Dyadic where
  type MinMaxType Integer Dyadic = Dyadic
  min :: Integer -> Dyadic -> MinMaxType Integer Dyadic
min = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: Integer -> Dyadic -> MinMaxType Integer Dyadic
max = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max
instance CanMinMaxAsymmetric Dyadic Integer where
  type MinMaxType Dyadic Integer = Dyadic
  min :: Dyadic -> Integer -> MinMaxType Dyadic Integer
min = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: Dyadic -> Integer -> MinMaxType Dyadic Integer
max = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max
instance CanMinMaxAsymmetric Int Dyadic where
  type MinMaxType Int Dyadic = Dyadic
  min :: Int -> Dyadic -> MinMaxType Int Dyadic
min = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: Int -> Dyadic -> MinMaxType Int Dyadic
max = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max
instance CanMinMaxAsymmetric Dyadic Int where
  type MinMaxType Dyadic Int = Dyadic
  min :: Dyadic -> Int -> MinMaxType Dyadic Int
min = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: Dyadic -> Int -> MinMaxType Dyadic Int
max = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max
instance CanMinMaxAsymmetric Rational Dyadic where
  type MinMaxType Rational Dyadic = Rational
  min :: Rational -> Dyadic -> MinMaxType Rational Dyadic
min = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: Rational -> Dyadic -> MinMaxType Rational Dyadic
max = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max
instance CanMinMaxAsymmetric Dyadic Rational where
  type MinMaxType Dyadic Rational = Rational
  min :: Dyadic -> Rational -> MinMaxType Dyadic Rational
min = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: Dyadic -> Rational -> MinMaxType Dyadic Rational
max = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max

instance
  (CanMinMaxAsymmetric Dyadic b
  , CanBeErrors es)
  =>
  CanMinMaxAsymmetric Dyadic (CollectErrors es  b)
  where
  type MinMaxType Dyadic (CollectErrors es  b) =
    CollectErrors es (MinMaxType Dyadic b)
  min :: Dyadic
-> CollectErrors es b -> MinMaxType Dyadic (CollectErrors es b)
min = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: Dyadic
-> CollectErrors es b -> MinMaxType Dyadic (CollectErrors es b)
max = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max

instance
  (CanMinMaxAsymmetric a Dyadic
  , CanBeErrors es)
  =>
  CanMinMaxAsymmetric (CollectErrors es a) Dyadic
  where
  type MinMaxType (CollectErrors es  a) Dyadic =
    CollectErrors es (MinMaxType a Dyadic)
  min :: CollectErrors es a
-> Dyadic -> MinMaxType (CollectErrors es a) Dyadic
min = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: CollectErrors es a
-> Dyadic -> MinMaxType (CollectErrors es a) Dyadic
max = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max

{- addition -}

instance CanAddAsymmetric Dyadic Dyadic where
  add :: Dyadic -> Dyadic -> AddType Dyadic Dyadic
add = (MPFloat -> MPFloat -> BoundsCEDU MPFloat)
-> Dyadic -> Dyadic -> Dyadic
lift2 MPFloat -> MPFloat -> BoundsCEDU MPFloat
addCEDU

instance CanAddAsymmetric Integer Dyadic where
  type AddType Integer Dyadic = Dyadic
  add :: Integer -> Dyadic -> AddType Integer Dyadic
add = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add
instance CanAddAsymmetric Dyadic Integer where
  type AddType Dyadic Integer = Dyadic
  add :: Dyadic -> Integer -> AddType Dyadic Integer
add = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add

instance CanAddAsymmetric Int Dyadic where
  type AddType Int Dyadic = Dyadic
  add :: Int -> Dyadic -> AddType Int Dyadic
add = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add
instance CanAddAsymmetric Dyadic Int where
  type AddType Dyadic Int = Dyadic
  add :: Dyadic -> Int -> AddType Dyadic Int
add = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add

instance CanAddAsymmetric Rational Dyadic where
  type AddType Rational Dyadic = Rational
  add :: Rational -> Dyadic -> AddType Rational Dyadic
add = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add
instance CanAddAsymmetric Dyadic Rational where
  type AddType Dyadic Rational = Rational
  add :: Dyadic -> Rational -> AddType Dyadic Rational
add = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add

instance
  (CanAddAsymmetric Dyadic b
  , CanBeErrors es)
  =>
  CanAddAsymmetric Dyadic (CollectErrors es  b)
  where
  type AddType Dyadic (CollectErrors es  b) =
    CollectErrors es (AddType Dyadic b)
  add :: Dyadic -> CollectErrors es b -> AddType Dyadic (CollectErrors es b)
add = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add

instance
  (CanAddAsymmetric a Dyadic
  , CanBeErrors es)
  =>
  CanAddAsymmetric (CollectErrors es a) Dyadic
  where
  type AddType (CollectErrors es  a) Dyadic =
    CollectErrors es (AddType a Dyadic)
  add :: CollectErrors es a -> Dyadic -> AddType (CollectErrors es a) Dyadic
add = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add

{- subtraction -}

instance CanSub Dyadic Dyadic where
  sub :: Dyadic -> Dyadic -> SubType Dyadic Dyadic
sub = (MPFloat -> MPFloat -> BoundsCEDU MPFloat)
-> Dyadic -> Dyadic -> Dyadic
lift2 MPFloat -> MPFloat -> BoundsCEDU MPFloat
subCEDU

instance CanSub Integer Dyadic where
  type SubType Integer Dyadic = Dyadic
  sub :: Integer -> Dyadic -> SubType Integer Dyadic
sub = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub
instance CanSub Dyadic Integer where
  type SubType Dyadic Integer = Dyadic
  sub :: Dyadic -> Integer -> SubType Dyadic Integer
sub = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub

instance CanSub Int Dyadic where
  type SubType Int Dyadic = Dyadic
  sub :: Int -> Dyadic -> SubType Int Dyadic
sub = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub
instance CanSub Dyadic Int where
  type SubType Dyadic Int = Dyadic
  sub :: Dyadic -> Int -> SubType Dyadic Int
sub = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub

instance CanSub Rational Dyadic where
  type SubType Rational Dyadic = Rational
  sub :: Rational -> Dyadic -> SubType Rational Dyadic
sub = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub
instance CanSub Dyadic Rational where
  type SubType Dyadic Rational = Rational
  sub :: Dyadic -> Rational -> SubType Dyadic Rational
sub = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub

instance
  (CanSub Dyadic b
  , CanBeErrors es)
  =>
  CanSub Dyadic (CollectErrors es  b)
  where
  type SubType Dyadic (CollectErrors es  b) =
    CollectErrors es (SubType Dyadic b)
  sub :: Dyadic -> CollectErrors es b -> SubType Dyadic (CollectErrors es b)
sub = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub

instance
  (CanSub a Dyadic
  , CanBeErrors es)
  =>
  CanSub (CollectErrors es a) Dyadic
  where
  type SubType (CollectErrors es  a) Dyadic =
    CollectErrors es (SubType a Dyadic)
  sub :: CollectErrors es a -> Dyadic -> SubType (CollectErrors es a) Dyadic
sub = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub


{- multiplication -}

instance CanMulAsymmetric Dyadic Dyadic where
  mul :: Dyadic -> Dyadic -> MulType Dyadic Dyadic
mul = (MPFloat -> MPFloat -> BoundsCEDU MPFloat)
-> Dyadic -> Dyadic -> Dyadic
lift2 MPFloat -> MPFloat -> BoundsCEDU MPFloat
mulCEDU

instance CanMulAsymmetric Integer Dyadic where
  type MulType Integer Dyadic = Dyadic
  mul :: Integer -> Dyadic -> MulType Integer Dyadic
mul = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul
instance CanMulAsymmetric Dyadic Integer where
  type MulType Dyadic Integer = Dyadic
  mul :: Dyadic -> Integer -> MulType Dyadic Integer
mul = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul

instance CanMulAsymmetric Int Dyadic where
  type MulType Int Dyadic = Dyadic
  mul :: Int -> Dyadic -> MulType Int Dyadic
mul = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul
instance CanMulAsymmetric Dyadic Int where
  type MulType Dyadic Int = Dyadic
  mul :: Dyadic -> Int -> MulType Dyadic Int
mul = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul

instance CanMulAsymmetric Rational Dyadic where
  type MulType Rational Dyadic = Rational
  mul :: Rational -> Dyadic -> MulType Rational Dyadic
mul = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul
instance CanMulAsymmetric Dyadic Rational where
  type MulType Dyadic Rational = Rational
  mul :: Dyadic -> Rational -> MulType Dyadic Rational
mul = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul

instance
  (CanMulAsymmetric Dyadic b
  , CanBeErrors es)
  =>
  CanMulAsymmetric Dyadic (CollectErrors es  b)
  where
  type MulType Dyadic (CollectErrors es  b) =
    CollectErrors es (MulType Dyadic b)
  mul :: Dyadic -> CollectErrors es b -> MulType Dyadic (CollectErrors es b)
mul = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul

instance
  (CanMulAsymmetric a Dyadic
  , CanBeErrors es)
  =>
  CanMulAsymmetric (CollectErrors es a) Dyadic
  where
  type MulType (CollectErrors es  a) Dyadic =
    CollectErrors es (MulType a Dyadic)
  mul :: CollectErrors es a -> Dyadic -> MulType (CollectErrors es a) Dyadic
mul = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul

instance CanPow Dyadic Integer where
  pow :: Dyadic -> Integer -> PowType Dyadic Integer
pow = forall e t. CanBeInteger e => t -> (t -> t -> t) -> t -> e -> t
powUsingMul (forall t. CanBeDyadic t => t -> Dyadic
dyadic Integer
1) forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
(*)
instance CanPow Dyadic Int where
  pow :: Dyadic -> Int -> PowType Dyadic Int
pow = forall e t. CanBeInteger e => t -> (t -> t -> t) -> t -> e -> t
powUsingMul (forall t. CanBeDyadic t => t -> Dyadic
dyadic Integer
1) forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
(*)

instance
  (CanDiv a Dyadic
  , CanBeErrors es)
  =>
  CanDiv (CollectErrors es a) Dyadic
  where
  type DivType (CollectErrors es  a) Dyadic =
    CollectErrors es (DivType a Dyadic)
  divide :: CollectErrors es a -> Dyadic -> DivType (CollectErrors es a) Dyadic
divide = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide

instance CanDiv Integer Dyadic where
  type DivType Integer Dyadic = Rational
  divide :: Integer -> Dyadic -> DivType Integer Dyadic
divide Integer
a Dyadic
b = forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide Integer
a (forall t. CanBeRational t => t -> Rational
rational Dyadic
b)
instance CanDiv Dyadic Integer where
  type DivType Dyadic Integer = Rational
  divide :: Dyadic -> Integer -> DivType Dyadic Integer
divide Dyadic
a Integer
b = forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide (forall t. CanBeRational t => t -> Rational
rational Dyadic
a) Integer
b

instance CanDiv Int Dyadic where
  type DivType Int Dyadic = Rational
  divide :: Int -> Dyadic -> DivType Int Dyadic
divide Int
a Dyadic
b = forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide Int
a (forall t. CanBeRational t => t -> Rational
rational Dyadic
b)
instance CanDiv Dyadic Int where
  type DivType Dyadic Int = Rational
  divide :: Dyadic -> Int -> DivType Dyadic Int
divide Dyadic
a Int
b = forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide (forall t. CanBeRational t => t -> Rational
rational Dyadic
a) Int
b

instance CanDiv Rational Dyadic where
  type DivType Rational Dyadic = Rational
  divide :: Rational -> Dyadic -> DivType Rational Dyadic
divide = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide
instance CanDiv Dyadic Rational where
  type DivType Dyadic Rational = Rational
  divide :: Dyadic -> Rational -> DivType Dyadic Rational
divide = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide

instance
  (CanDiv Dyadic b
  , CanBeErrors es)
  =>
  CanDiv Dyadic (CollectErrors es b)
  where
  type DivType Dyadic (CollectErrors es b) =
    CollectErrors es (DivType Dyadic b)
  divide :: Dyadic -> CollectErrors es b -> DivType Dyadic (CollectErrors es b)
divide = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide

instance
  (CanPow Dyadic b
  , CanBeErrors es)
  =>
  CanPow Dyadic (CollectErrors es  b)
  where
  type PowType Dyadic (CollectErrors es b) =
    CollectErrors es (PowType Dyadic b)
  pow :: Dyadic -> CollectErrors es b -> PowType Dyadic (CollectErrors es b)
pow = forall es a b c.
Monoid es =>
(a -> b -> c) -> a -> CollectErrors es b -> CollectErrors es c
CE.liftT1 forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
pow

instance
  (CanPow a Dyadic
  , CanBeErrors es)
  =>
  CanPow (CollectErrors es a) Dyadic
  where
  type PowType (CollectErrors es  a) Dyadic =
    CollectErrors es (PowType a Dyadic)
  pow :: CollectErrors es a -> Dyadic -> PowType (CollectErrors es a) Dyadic
pow = forall es a b c.
Monoid es =>
(a -> b -> c) -> CollectErrors es a -> b -> CollectErrors es c
CE.lift1T forall t1 t2. CanPow t1 t2 => t1 -> t2 -> PowType t1 t2
pow

instance CanTestFinite Dyadic where
  isFinite :: Dyadic -> Bool
isFinite = forall t. CanTestFinite t => t -> Bool
isFinite forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dyadic -> MPFloat
dyadicMPFloat
  isInfinite :: Dyadic -> Bool
isInfinite = forall t. CanTestFinite t => t -> Bool
isInfinite forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dyadic -> MPFloat
dyadicMPFloat

lift2 ::
  (MPFloat -> MPFloat -> BoundsCEDU MPFloat) ->
  (Dyadic -> Dyadic -> Dyadic)
lift2 :: (MPFloat -> MPFloat -> BoundsCEDU MPFloat)
-> Dyadic -> Dyadic -> Dyadic
lift2 MPFloat -> MPFloat -> BoundsCEDU MPFloat
opCEDU (Dyadic MPFloat
x0) (Dyadic MPFloat
y0) = MPFloat -> Dyadic
Dyadic (MPFloat -> MPFloat -> MPFloat
opExact MPFloat
x0 MPFloat
y0)
  where
    opExact :: MPFloat -> MPFloat -> MPFloat
opExact MPFloat
x MPFloat
y
      | MPFloat
rE forall a. Eq a => a -> a -> Bool
P.== MPFloat
zero = MPFloat
rC
      | Bool
otherwise =
          maybeTrace (printf "Dyadic.lift2: rC = %s; rE = %s; p = %s" (show rC) (show rE) (show $ integer p)) $
          MPFloat -> MPFloat -> MPFloat
opExact MPFloat
xH MPFloat
yH
      where
      rC :: MPFloat
rC = forall a. BoundsCEDU a -> a
ceduCentre BoundsCEDU MPFloat
rCEDU
      rE :: MPFloat
rE = forall a. BoundsCEDU a -> a
ceduErr BoundsCEDU MPFloat
rCEDU
      rCEDU :: BoundsCEDU MPFloat
rCEDU = MPFloat -> MPFloat -> BoundsCEDU MPFloat
opCEDU MPFloat
x MPFloat
y
      xH :: MPFloat
xH = forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
pH MPFloat
x
      yH :: MPFloat
yH = forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
pH MPFloat
y
      pH :: Precision
pH = Precision -> Precision
precisionTimes2 Precision
p
      p :: Precision
p = forall t. HasPrecision t => t -> Precision
getPrecision MPFloat
rC

instance Arbitrary Dyadic where
  arbitrary :: Gen Dyadic
arbitrary =
    do
      MPFloat
c <- Gen MPFloat
finiteMPFloat
      forall (m :: * -> *) a. Monad m => a -> m a
return (MPFloat -> Dyadic
Dyadic MPFloat
c)
    where
      finiteMPFloat :: Gen MPFloat
finiteMPFloat =
        do
          MPFloat
x <- forall a. Arbitrary a => Gen a
arbitrary
          if forall t. CanTestFinite t => t -> Bool
isFinite MPFloat
x
            then forall (m :: * -> *) a. Monad m => a -> m a
return MPFloat
x
            else Gen MPFloat
finiteMPFloat

{-|
  A runtime representative of type @Dyadic@.
  Used for specialising polymorphic tests to concrete types.
-}
tDyadic :: T Dyadic
tDyadic :: T Dyadic
tDyadic = forall t. String -> T t
T String
"Dyadic"

specDyadic :: Spec
specDyadic :: Spec
specDyadic =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
"Dyadic") forall a b. (a -> b) -> a -> b
$ do
    forall t1 t2.
(Arbitrary t1, Show t1, HasEqCertainly t1 t1) =>
T t1 -> T t2 -> (t1 -> t2) -> (t2 -> t1) -> Spec
specConversion T Integer
tInteger T Dyadic
tDyadic forall t. CanBeDyadic t => t -> Dyadic
dyadic forall t. CanRound t => t -> RoundType t
round
    forall t1 t2.
(Arbitrary t1, Show t1, HasEqCertainly t1 t1) =>
T t1 -> T t2 -> (t1 -> t2) -> (t2 -> t1) -> Spec
specConversion T Dyadic
tDyadic T Rational
tRational forall t. CanBeRational t => t -> Rational
rational forall t. CanBeDyadic t => t -> Dyadic
dyadic
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"order" forall a b. (a -> b) -> a -> b
$ do
      forall t.
(Arbitrary t, Show t,
 CanTestCertainly
   (AndOrType (EqCompareType t t) (EqCompareType t t)),
 CanTestCertainly (EqCompareType t t), HasEqAsymmetric t t) =>
T t -> Spec
specHasEqNotMixed T Dyadic
tDyadic
      forall t1 t2 t3.
(Arbitrary t1, Arbitrary t2, Arbitrary t3, Show t1, Show t2,
 Show t3,
 CanTestCertainly
   (AndOrType (EqCompareType t1 t2) (EqCompareType t2 t3)),
 CanTestCertainly (EqCompareType t1 t1),
 CanTestCertainly (EqCompareType t1 t2),
 CanTestCertainly (EqCompareType t2 t1),
 CanTestCertainly (EqCompareType t2 t3), HasEqAsymmetric t1 t1,
 HasEqAsymmetric t1 t2, HasEqAsymmetric t2 t1,
 HasEqAsymmetric t2 t3,
 CanAndOrAsymmetric (EqCompareType t1 t2) (EqCompareType t2 t3)) =>
T t1 -> T t2 -> T t3 -> Spec
specHasEq T Int
tInt T Dyadic
tDyadic T Rational
tRational
      forall t.
(CanTestZero t, ConvertibleExactly Integer t) =>
T t -> Spec
specCanTestZero T Dyadic
tDyadic
      forall t.
(Arbitrary t, Show t,
 CanTestCertainly
   (AndOrType (OrderCompareType t t) (OrderCompareType t t)),
 CanTestCertainly (OrderCompareType t t), HasOrderAsymmetric t t) =>
T t -> Spec
specHasOrderNotMixed T Dyadic
tDyadic
      forall t1 t2 t3.
(Arbitrary t1, Arbitrary t2, Arbitrary t3, Show t1, Show t2,
 Show t3,
 CanTestCertainly
   (AndOrType (OrderCompareType t1 t2) (OrderCompareType t2 t3)),
 CanTestCertainly (OrderCompareType t1 t1),
 CanTestCertainly (OrderCompareType t1 t2),
 CanTestCertainly (OrderCompareType t2 t1),
 CanTestCertainly (OrderCompareType t2 t3),
 HasOrderAsymmetric t1 t1, HasOrderAsymmetric t1 t2,
 HasOrderAsymmetric t2 t1, HasOrderAsymmetric t2 t3,
 CanAndOrAsymmetric
   (OrderCompareType t1 t2) (OrderCompareType t2 t3)) =>
T t1 -> T t2 -> T t3 -> Spec
specHasOrder T Int
tInt T Dyadic
tDyadic T Rational
tRational
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"min/max/abs" forall a b. (a -> b) -> a -> b
$ do
      forall t.
(Arbitrary t, Show t, Show (NegType (NegType t)),
 HasEqAsymmetric t t, HasEqAsymmetric (NegType t) t,
 HasEqAsymmetric (NegType (NegType t)) t,
 CanTestCertainly (EqCompareType t t),
 CanTestCertainly (EqCompareType (NegType t) t),
 CanTestCertainly (EqCompareType (NegType (NegType t)) t),
 CanTestFinite t, CanTestPosNeg t, CanTestPosNeg (NegType t),
 ConvertibleExactly Integer t, CanNeg t, CanNeg (NegType t)) =>
T t -> Spec
specCanNegNum T Dyadic
tDyadic
      forall t.
(Arbitrary t, CanAbs t, CanAbs (AbsType t), CanTestFinite t,
 HasEqAsymmetric t t, HasEqAsymmetric t (AbsType t),
 HasEqAsymmetric (AbsType (AbsType t)) (AbsType t),
 HasEqAsymmetric (NegType t) (AbsType t),
 CanTestCertainly (EqCompareType t t),
 CanTestCertainly (EqCompareType t (AbsType t)),
 CanTestCertainly (EqCompareType (AbsType (AbsType t)) (AbsType t)),
 CanTestCertainly (EqCompareType (NegType t) (AbsType t)), Show t,
 Show (AbsType t), Show (AbsType (AbsType t)), Show (NegType t),
 CanTestPosNeg t, CanTestPosNeg (AbsType t), CanNeg t) =>
T t -> Spec
specCanAbs T Dyadic
tDyadic
      forall t.
(HasOrderAsymmetric (MinMaxType t t) t, Arbitrary t,
 CanTestFinite t, HasEqAsymmetric (MinMaxType t t) t,
 HasEqAsymmetric (MinMaxType t t) (MinMaxType t t),
 HasEqAsymmetric
   (MinMaxType t (MinMaxType t t)) (MinMaxType (MinMaxType t t) t),
 CanTestCertainly (OrderCompareType (MinMaxType t t) t),
 CanTestCertainly (EqCompareType (MinMaxType t t) t),
 CanTestCertainly (EqCompareType (MinMaxType t t) (MinMaxType t t)),
 CanTestCertainly
   (EqCompareType
      (MinMaxType t (MinMaxType t t)) (MinMaxType (MinMaxType t t) t)),
 Show t, Show (MinMaxType t t),
 Show (MinMaxType t (MinMaxType t t)),
 Show (MinMaxType (MinMaxType t t) t), CanMinMaxAsymmetric t t,
 CanMinMaxAsymmetric t (MinMaxType t t),
 CanMinMaxAsymmetric (MinMaxType t t) t) =>
T t -> Spec
specCanMinMaxNotMixed T Dyadic
tDyadic
      forall t1 t2 t3.
(HasOrderAsymmetric (MinMaxType t1 t2) t2,
 HasOrderAsymmetric (MinMaxType t1 t2) t1, Arbitrary t1,
 Arbitrary t2, Arbitrary t3, CanTestFinite t1, CanTestFinite t2,
 CanTestFinite t3, HasEqAsymmetric (MinMaxType t1 t1) t1,
 HasEqAsymmetric (MinMaxType t1 t2) (MinMaxType t2 t1),
 HasEqAsymmetric
   (MinMaxType t1 (MinMaxType t2 t3))
   (MinMaxType (MinMaxType t1 t2) t3),
 CanTestCertainly (OrderCompareType (MinMaxType t1 t2) t2),
 CanTestCertainly (OrderCompareType (MinMaxType t1 t2) t1),
 CanTestCertainly (EqCompareType (MinMaxType t1 t1) t1),
 CanTestCertainly
   (EqCompareType (MinMaxType t1 t2) (MinMaxType t2 t1)),
 CanTestCertainly
   (EqCompareType
      (MinMaxType t1 (MinMaxType t2 t3))
      (MinMaxType (MinMaxType t1 t2) t3)),
 Show t1, Show t2, Show t3, Show (MinMaxType t2 t1),
 Show (MinMaxType t1 t2), Show (MinMaxType t1 t1),
 Show (MinMaxType t1 (MinMaxType t2 t3)),
 Show (MinMaxType (MinMaxType t1 t2) t3), CanMinMaxAsymmetric t1 t2,
 CanMinMaxAsymmetric t1 t1,
 CanMinMaxAsymmetric t1 (MinMaxType t2 t3),
 CanMinMaxAsymmetric t2 t1, CanMinMaxAsymmetric t2 t3,
 CanMinMaxAsymmetric (MinMaxType t1 t2) t3) =>
T t1 -> T t2 -> T t3 -> Spec
specCanMinMax T Dyadic
tDyadic T Integer
tInteger T Dyadic
tDyadic
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"min Dyadic Rational (dyadic only)" forall a b. (a -> b) -> a -> b
$ do
        forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (Dyadic
x :: Dyadic) (Dyadic
y :: Dyadic) ->
          Dyadic
x forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`min` Dyadic
y forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Dyadic
x forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`min` (forall t. CanBeRational t => t -> Rational
rational Dyadic
y)
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"max Dyadic Rational (dyadic only)" forall a b. (a -> b) -> a -> b
$ do
        forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (Dyadic
x :: Dyadic) (Dyadic
y :: Dyadic) ->
          Dyadic
x forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`max` Dyadic
y forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Dyadic
x forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`max` (forall t. CanBeRational t => t -> Rational
rational Dyadic
y)
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"ring" forall a b. (a -> b) -> a -> b
$ do
      forall t.
(Arbitrary t, HasEqAsymmetric (AddType t t) t,
 HasEqAsymmetric (AddType t t) (AddType t t),
 HasEqAsymmetric
   (AddType t (AddType t t)) (AddType (AddType t t) t),
 Show t, Show (AddType t t), Show (AddType t (AddType t t)),
 Show (AddType (AddType t t) t), CanAddAsymmetric t t,
 CanAddAsymmetric t (AddType t t), CanAddAsymmetric (AddType t t) t,
 CanTestPosNeg t, HasOrderAsymmetric (AddType t t) t,
 CanTestCertainly (EqCompareType (AddType t t) t),
 CanTestCertainly (EqCompareType (AddType t t) (AddType t t)),
 CanTestCertainly
   (EqCompareType
      (AddType t (AddType t t)) (AddType (AddType t t) t)),
 CanTestCertainly (OrderCompareType (AddType t t) t),
 ConvertibleExactly Integer t) =>
T t -> Spec
specCanAddNotMixed T Dyadic
tDyadic
      forall t.
(ConvertibleExactly Integer t, Show t, HasEqCertainly t t,
 CanAddSameType t) =>
T t -> Spec
specCanAddSameType T Dyadic
tDyadic
      forall t1 t2 t3.
(Arbitrary t1, Arbitrary t2, Arbitrary t3,
 HasEqAsymmetric (AddType t1 t1) t1,
 HasEqAsymmetric (AddType t1 t2) (AddType t2 t1),
 HasEqAsymmetric
   (AddType t1 (AddType t2 t3)) (AddType (AddType t1 t2) t3),
 Show t1, Show t2, Show t3, Show (AddType t2 t1),
 Show (AddType t1 t1), Show (AddType t1 t2),
 Show (AddType t1 (AddType t2 t3)),
 Show (AddType (AddType t1 t2) t3), CanAddAsymmetric t1 t1,
 CanAddAsymmetric t1 t2, CanAddAsymmetric t1 (AddType t2 t3),
 CanAddAsymmetric t2 t1, CanAddAsymmetric t2 t3,
 CanAddAsymmetric (AddType t1 t2) t3, CanTestPosNeg t1,
 HasOrderAsymmetric (AddType t1 t2) t2,
 CanTestCertainly (EqCompareType (AddType t1 t1) t1),
 CanTestCertainly (EqCompareType (AddType t1 t2) (AddType t2 t1)),
 CanTestCertainly
   (EqCompareType
      (AddType t1 (AddType t2 t3)) (AddType (AddType t1 t2) t3)),
 CanTestCertainly (OrderCompareType (AddType t1 t2) t2),
 ConvertibleExactly Integer t1) =>
T t1 -> T t2 -> T t3 -> Spec
specCanAdd T Int
tInt T Dyadic
tDyadic T Integer
tInteger
      forall t1 t2 t3.
(Arbitrary t1, Arbitrary t2, Arbitrary t3,
 HasEqAsymmetric (AddType t1 t1) t1,
 HasEqAsymmetric (AddType t1 t2) (AddType t2 t1),
 HasEqAsymmetric
   (AddType t1 (AddType t2 t3)) (AddType (AddType t1 t2) t3),
 Show t1, Show t2, Show t3, Show (AddType t2 t1),
 Show (AddType t1 t1), Show (AddType t1 t2),
 Show (AddType t1 (AddType t2 t3)),
 Show (AddType (AddType t1 t2) t3), CanAddAsymmetric t1 t1,
 CanAddAsymmetric t1 t2, CanAddAsymmetric t1 (AddType t2 t3),
 CanAddAsymmetric t2 t1, CanAddAsymmetric t2 t3,
 CanAddAsymmetric (AddType t1 t2) t3, CanTestPosNeg t1,
 HasOrderAsymmetric (AddType t1 t2) t2,
 CanTestCertainly (EqCompareType (AddType t1 t1) t1),
 CanTestCertainly (EqCompareType (AddType t1 t2) (AddType t2 t1)),
 CanTestCertainly
   (EqCompareType
      (AddType t1 (AddType t2 t3)) (AddType (AddType t1 t2) t3)),
 CanTestCertainly (OrderCompareType (AddType t1 t2) t2),
 ConvertibleExactly Integer t1) =>
T t1 -> T t2 -> T t3 -> Spec
specCanAdd T Integer
tInteger T Dyadic
tDyadic T Int
tInt
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Dyadic + Rational (dyadic only)" forall a b. (a -> b) -> a -> b
$ do
        forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (Dyadic
x :: Dyadic) (Dyadic
y :: Dyadic) ->
          Dyadic
x forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Dyadic
y forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Dyadic
x forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (forall t. CanBeRational t => t -> Rational
rational Dyadic
y)
      forall t.
(Arbitrary t, HasEqAsymmetric (SubType t t) t,
 HasEqAsymmetric (SubType t t) (AddType t (NegType t)),
 CanTestCertainly (EqCompareType (SubType t t) t),
 CanTestCertainly
   (EqCompareType (SubType t t) (AddType t (NegType t))),
 Show t, Show (SubType t t), Show (AddType t (NegType t)),
 CanSub t t, CanAddAsymmetric t (NegType t),
 ConvertibleExactly Integer t, CanNeg t) =>
T t -> Spec
specCanSubNotMixed T Dyadic
tDyadic
      forall t1 t2.
(Arbitrary t1, Arbitrary t2, HasEqAsymmetric (SubType t1 t1) t1,
 HasEqAsymmetric (SubType t1 t2) (AddType t1 (NegType t2)),
 CanTestCertainly (EqCompareType (SubType t1 t1) t1),
 CanTestCertainly
   (EqCompareType (SubType t1 t2) (AddType t1 (NegType t2))),
 Show t1, Show t2, Show (SubType t1 t1), Show (SubType t1 t2),
 Show (AddType t1 (NegType t2)), CanSub t1 t1, CanSub t1 t2,
 CanAddAsymmetric t1 (NegType t2), ConvertibleExactly Integer t1,
 CanNeg t2) =>
T t1 -> T t2 -> Spec
specCanSub T Dyadic
tDyadic T Integer
tInteger
      forall t1 t2.
(Arbitrary t1, Arbitrary t2, HasEqAsymmetric (SubType t1 t1) t1,
 HasEqAsymmetric (SubType t1 t2) (AddType t1 (NegType t2)),
 CanTestCertainly (EqCompareType (SubType t1 t1) t1),
 CanTestCertainly
   (EqCompareType (SubType t1 t2) (AddType t1 (NegType t2))),
 Show t1, Show t2, Show (SubType t1 t1), Show (SubType t1 t2),
 Show (AddType t1 (NegType t2)), CanSub t1 t1, CanSub t1 t2,
 CanAddAsymmetric t1 (NegType t2), ConvertibleExactly Integer t1,
 CanNeg t2) =>
T t1 -> T t2 -> Spec
specCanSub T Integer
tInteger T Dyadic
tDyadic
      forall t1 t2.
(Arbitrary t1, Arbitrary t2, HasEqAsymmetric (SubType t1 t1) t1,
 HasEqAsymmetric (SubType t1 t2) (AddType t1 (NegType t2)),
 CanTestCertainly (EqCompareType (SubType t1 t1) t1),
 CanTestCertainly
   (EqCompareType (SubType t1 t2) (AddType t1 (NegType t2))),
 Show t1, Show t2, Show (SubType t1 t1), Show (SubType t1 t2),
 Show (AddType t1 (NegType t2)), CanSub t1 t1, CanSub t1 t2,
 CanAddAsymmetric t1 (NegType t2), ConvertibleExactly Integer t1,
 CanNeg t2) =>
T t1 -> T t2 -> Spec
specCanSub T Dyadic
tDyadic T Int
tInt
      forall t1 t2.
(Arbitrary t1, Arbitrary t2, HasEqAsymmetric (SubType t1 t1) t1,
 HasEqAsymmetric (SubType t1 t2) (AddType t1 (NegType t2)),
 CanTestCertainly (EqCompareType (SubType t1 t1) t1),
 CanTestCertainly
   (EqCompareType (SubType t1 t2) (AddType t1 (NegType t2))),
 Show t1, Show t2, Show (SubType t1 t1), Show (SubType t1 t2),
 Show (AddType t1 (NegType t2)), CanSub t1 t1, CanSub t1 t2,
 CanAddAsymmetric t1 (NegType t2), ConvertibleExactly Integer t1,
 CanNeg t2) =>
T t1 -> T t2 -> Spec
specCanSub T Int
tInt T Dyadic
tDyadic
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Dyadic - Rational (dyadic only)" forall a b. (a -> b) -> a -> b
$ do
        forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (Dyadic
x :: Dyadic) (Dyadic
y :: Dyadic) ->
          Dyadic
x forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Dyadic
y forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Dyadic
x forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- (forall t. CanBeRational t => t -> Rational
rational Dyadic
y)
      forall t.
(Arbitrary t, HasEqAsymmetric (MulType t t) t,
 HasEqAsymmetric (MulType t t) (MulType t t),
 HasEqAsymmetric
   (MulType t (MulType t t)) (MulType (MulType t t) t),
 HasEqAsymmetric
   (MulType t (AddType t t)) (AddType (MulType t t) (MulType t t)),
 CanTestCertainly (EqCompareType (MulType t t) t),
 CanTestCertainly (EqCompareType (MulType t t) (MulType t t)),
 CanTestCertainly
   (EqCompareType
      (MulType t (MulType t t)) (MulType (MulType t t) t)),
 CanTestCertainly
   (EqCompareType
      (MulType t (AddType t t)) (AddType (MulType t t) (MulType t t))),
 Show t, Show (MulType t t), Show (MulType t (MulType t t)),
 Show (MulType t (AddType t t)), Show (MulType (MulType t t) t),
 Show (AddType (MulType t t) (MulType t t)), CanAddAsymmetric t t,
 CanAddAsymmetric (MulType t t) (MulType t t), CanMulAsymmetric t t,
 CanMulAsymmetric t (MulType t t), CanMulAsymmetric t (AddType t t),
 CanMulAsymmetric (MulType t t) t, ConvertibleExactly Integer t) =>
T t -> Spec
specCanMulNotMixed T Dyadic
tDyadic
      forall t.
(Show t, ConvertibleExactly Integer t,
 CanTestCertainly (EqCompareType t t), HasEqAsymmetric t t,
 CanMulAsymmetric t t, MulType t t ~ t) =>
T t -> Spec
specCanMulSameType T Dyadic
tDyadic
      forall t1 t2 t3.
(Arbitrary t1, Arbitrary t2, Arbitrary t3,
 HasEqAsymmetric (MulType t1 t2) t1,
 HasEqAsymmetric (MulType t1 t2) (MulType t2 t1),
 HasEqAsymmetric
   (MulType t1 (MulType t2 t3)) (MulType (MulType t1 t2) t3),
 HasEqAsymmetric
   (MulType t1 (AddType t2 t3))
   (AddType (MulType t1 t2) (MulType t1 t3)),
 CanTestCertainly (EqCompareType (MulType t1 t2) t1),
 CanTestCertainly (EqCompareType (MulType t1 t2) (MulType t2 t1)),
 CanTestCertainly
   (EqCompareType
      (MulType t1 (MulType t2 t3)) (MulType (MulType t1 t2) t3)),
 CanTestCertainly
   (EqCompareType
      (MulType t1 (AddType t2 t3))
      (AddType (MulType t1 t2) (MulType t1 t3))),
 Show t1, Show t2, Show t3, Show (MulType t2 t1),
 Show (MulType t1 t2), Show (MulType t1 (MulType t2 t3)),
 Show (MulType t1 (AddType t2 t3)),
 Show (MulType (MulType t1 t2) t3),
 Show (AddType (MulType t1 t2) (MulType t1 t3)),
 CanAddAsymmetric t2 t3,
 CanAddAsymmetric (MulType t1 t2) (MulType t1 t3),
 CanMulAsymmetric t2 t1, CanMulAsymmetric t2 t3,
 CanMulAsymmetric t1 t2, CanMulAsymmetric t1 t3,
 CanMulAsymmetric t1 (MulType t2 t3),
 CanMulAsymmetric t1 (AddType t2 t3),
 CanMulAsymmetric (MulType t1 t2) t3,
 ConvertibleExactly Integer t2) =>
T t1 -> T t2 -> T t3 -> Spec
specCanMul T Int
tInt T Dyadic
tDyadic T Integer
tInteger
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Dyadic * Rational (dyadic only)" forall a b. (a -> b) -> a -> b
$ do
        forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (Dyadic
x :: Dyadic) (Dyadic
y :: Dyadic) ->
          Dyadic
x forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Dyadic
y forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Dyadic
x forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (forall t. CanBeRational t => t -> Rational
rational Dyadic
y)
      forall t1 t2.
(Arbitrary t1, Arbitrary t2, CanTestPosNeg t2,
 HasEqAsymmetric (PowType t1 t2) t1,
 HasEqAsymmetric
   (MulType t1 (PowType t1 t2)) (PowType t1 (AddType t2 Integer)),
 CanTestCertainly (EqCompareType (PowType t1 t2) t1),
 CanTestCertainly
   (EqCompareType
      (MulType t1 (PowType t1 t2)) (PowType t1 (AddType t2 Integer))),
 Show t1, Show t2, Show (MulType t1 (PowType t1 t2)),
 Show (PowType t1 t2), Show (PowType t1 (AddType t2 Integer)),
 CanMulAsymmetric t1 (PowType t1 t2), CanPow t1 t2,
 CanPow t1 (AddType t2 Integer), CanAddAsymmetric t2 Integer,
 ConvertibleExactly Integer t1, ConvertibleExactly Integer t2) =>
T t1 -> T t2 -> Spec
specCanPow T Dyadic
tDyadic T Integer
tInteger

instance P.Num Dyadic where
    fromInteger :: Integer -> Dyadic
fromInteger = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly
    negate :: Dyadic -> Dyadic
negate = forall t. CanNeg t => t -> NegType t
negate
    + :: Dyadic -> Dyadic -> Dyadic
(+) = forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
(+)
    * :: Dyadic -> Dyadic -> Dyadic
(*) = forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
(*)
    abs :: Dyadic -> Dyadic
abs = forall t. CanAbs t => t -> AbsType t
abs
    signum :: Dyadic -> Dyadic
signum Dyadic
d
      | Dyadic
d forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
0 = forall t. CanBeDyadic t => t -> Dyadic
dyadic (-Integer
1)
      | Dyadic
d forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
0 = forall t. CanBeDyadic t => t -> Dyadic
dyadic Integer
0
      | Bool
otherwise = forall t. CanBeDyadic t => t -> Dyadic
dyadic Integer
1

instance P.Real Dyadic where
    toRational :: Dyadic -> Rational
toRational = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly