{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module AERN2.MP.Precision
(
Precision, prec
, HasPrecision(..), CanSetPrecision(..), lowerPrecisionIfAbove, raisePrecisionIfBelow, specCanSetPrecision
, defaultPrecision, maximumPrecision, standardPrecisions, precisionTimes2
, iterateUntilOK
, ConvertibleWithPrecision(..), convertP
, convertPFirst, convertPSecond
)
where
import MixedTypesNumPrelude
import qualified Prelude as P
import Text.Printf
import Control.CollectErrors (CollectErrors(..), CanBeErrors)
import Data.Complex
import Data.Typeable
import Test.Hspec
import Test.QuickCheck
newtype Precision = Precision Integer
deriving (Precision -> Precision -> Bool
(Precision -> Precision -> Bool)
-> (Precision -> Precision -> Bool) -> Eq Precision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Precision -> Precision -> Bool
$c/= :: Precision -> Precision -> Bool
== :: Precision -> Precision -> Bool
$c== :: Precision -> Precision -> Bool
P.Eq, Eq Precision
Eq Precision
-> (Precision -> Precision -> Ordering)
-> (Precision -> Precision -> Bool)
-> (Precision -> Precision -> Bool)
-> (Precision -> Precision -> Bool)
-> (Precision -> Precision -> Bool)
-> (Precision -> Precision -> Precision)
-> (Precision -> Precision -> Precision)
-> Ord Precision
Precision -> Precision -> Bool
Precision -> Precision -> Ordering
Precision -> Precision -> Precision
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 :: Precision -> Precision -> Precision
$cmin :: Precision -> Precision -> Precision
max :: Precision -> Precision -> Precision
$cmax :: Precision -> Precision -> Precision
>= :: Precision -> Precision -> Bool
$c>= :: Precision -> Precision -> Bool
> :: Precision -> Precision -> Bool
$c> :: Precision -> Precision -> Bool
<= :: Precision -> Precision -> Bool
$c<= :: Precision -> Precision -> Bool
< :: Precision -> Precision -> Bool
$c< :: Precision -> Precision -> Bool
compare :: Precision -> Precision -> Ordering
$ccompare :: Precision -> Precision -> Ordering
$cp1Ord :: Eq Precision
P.Ord, Int -> Precision -> ShowS
[Precision] -> ShowS
Precision -> String
(Int -> Precision -> ShowS)
-> (Precision -> String)
-> ([Precision] -> ShowS)
-> Show Precision
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Precision] -> ShowS
$cshowList :: [Precision] -> ShowS
show :: Precision -> String
$cshow :: Precision -> String
showsPrec :: Int -> Precision -> ShowS
$cshowsPrec :: Int -> Precision -> ShowS
P.Show, Int -> Precision
Precision -> Int
Precision -> [Precision]
Precision -> Precision
Precision -> Precision -> [Precision]
Precision -> Precision -> Precision -> [Precision]
(Precision -> Precision)
-> (Precision -> Precision)
-> (Int -> Precision)
-> (Precision -> Int)
-> (Precision -> [Precision])
-> (Precision -> Precision -> [Precision])
-> (Precision -> Precision -> [Precision])
-> (Precision -> Precision -> Precision -> [Precision])
-> Enum Precision
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Precision -> Precision -> Precision -> [Precision]
$cenumFromThenTo :: Precision -> Precision -> Precision -> [Precision]
enumFromTo :: Precision -> Precision -> [Precision]
$cenumFromTo :: Precision -> Precision -> [Precision]
enumFromThen :: Precision -> Precision -> [Precision]
$cenumFromThen :: Precision -> Precision -> [Precision]
enumFrom :: Precision -> [Precision]
$cenumFrom :: Precision -> [Precision]
fromEnum :: Precision -> Int
$cfromEnum :: Precision -> Int
toEnum :: Int -> Precision
$ctoEnum :: Int -> Precision
pred :: Precision -> Precision
$cpred :: Precision -> Precision
succ :: Precision -> Precision
$csucc :: Precision -> Precision
P.Enum, Integer -> Precision
Precision -> Precision
Precision -> Precision -> Precision
(Precision -> Precision -> Precision)
-> (Precision -> Precision -> Precision)
-> (Precision -> Precision -> Precision)
-> (Precision -> Precision)
-> (Precision -> Precision)
-> (Precision -> Precision)
-> (Integer -> Precision)
-> Num Precision
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Precision
$cfromInteger :: Integer -> Precision
signum :: Precision -> Precision
$csignum :: Precision -> Precision
abs :: Precision -> Precision
$cabs :: Precision -> Precision
negate :: Precision -> Precision
$cnegate :: Precision -> Precision
* :: Precision -> Precision -> Precision
$c* :: Precision -> Precision -> Precision
- :: Precision -> Precision -> Precision
$c- :: Precision -> Precision -> Precision
+ :: Precision -> Precision -> Precision
$c+ :: Precision -> Precision -> Precision
P.Num, Num Precision
Ord Precision
Num Precision
-> Ord Precision -> (Precision -> Rational) -> Real Precision
Precision -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Precision -> Rational
$ctoRational :: Precision -> Rational
$cp2Real :: Ord Precision
$cp1Real :: Num Precision
P.Real, Enum Precision
Real Precision
Real Precision
-> Enum Precision
-> (Precision -> Precision -> Precision)
-> (Precision -> Precision -> Precision)
-> (Precision -> Precision -> Precision)
-> (Precision -> Precision -> Precision)
-> (Precision -> Precision -> (Precision, Precision))
-> (Precision -> Precision -> (Precision, Precision))
-> (Precision -> Integer)
-> Integral Precision
Precision -> Integer
Precision -> Precision -> (Precision, Precision)
Precision -> Precision -> Precision
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Precision -> Integer
$ctoInteger :: Precision -> Integer
divMod :: Precision -> Precision -> (Precision, Precision)
$cdivMod :: Precision -> Precision -> (Precision, Precision)
quotRem :: Precision -> Precision -> (Precision, Precision)
$cquotRem :: Precision -> Precision -> (Precision, Precision)
mod :: Precision -> Precision -> Precision
$cmod :: Precision -> Precision -> Precision
div :: Precision -> Precision -> Precision
$cdiv :: Precision -> Precision -> Precision
rem :: Precision -> Precision -> Precision
$crem :: Precision -> Precision -> Precision
quot :: Precision -> Precision -> Precision
$cquot :: Precision -> Precision -> Precision
$cp2Integral :: Enum Precision
$cp1Integral :: Real Precision
P.Integral, Typeable)
instance HasEqAsymmetric Precision Precision
instance HasOrderAsymmetric Precision Precision
instance CanMinMaxAsymmetric Precision Precision
instance ConvertibleExactly Precision Integer where
safeConvertExactly :: Precision -> ConvertResult Integer
safeConvertExactly (Precision Integer
p) = Integer -> ConvertResult Integer
forall a b. b -> Either a b
Right Integer
p
instance ConvertibleExactly Integer Precision where
safeConvertExactly :: Integer -> ConvertResult Precision
safeConvertExactly Integer
p
| Integer
p Integer -> Integer -> OrderCompareType Integer Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
2 = String -> Integer -> ConvertResult Precision
forall a b.
(Show a, Typeable a, Typeable b) =>
String -> a -> ConvertResult b
convError String
errmsg Integer
p
| Integer -> Precision
Precision Integer
p Precision -> Precision -> OrderCompareType Precision Precision
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Precision
maximumPrecision = String -> Integer -> ConvertResult Precision
forall a b.
(Show a, Typeable a, Typeable b) =>
String -> a -> ConvertResult b
convError String
errmsg Integer
p
| Bool
otherwise = Precision -> ConvertResult Precision
forall a b. b -> Either a b
Right (Precision -> ConvertResult Precision)
-> Precision -> ConvertResult Precision
forall a b. (a -> b) -> a -> b
$ Integer -> Precision
Precision Integer
p
where
errmsg :: String
errmsg =
String
"Precision must be between 2 and " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Precision -> String
forall a. Show a => a -> String
show Precision
maximumPrecision String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (given: p=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")."
prec :: Integer -> Precision
prec :: Integer -> Precision
prec = Integer -> Precision
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly
instance HasEqAsymmetric Precision Integer where
equalTo :: Precision -> Integer -> EqCompareType Precision Integer
equalTo Precision
p Integer
i = Precision -> Precision -> EqCompareType Precision Precision
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo Precision
p (Integer -> Precision
prec Integer
i)
instance HasEqAsymmetric Integer Precision where
equalTo :: Integer -> Precision -> EqCompareType Integer Precision
equalTo Integer
i Precision
p = Precision -> Precision -> EqCompareType Precision Precision
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo (Integer -> Precision
prec Integer
i) Precision
p
instance HasOrderAsymmetric Precision Integer where
lessThan :: Precision -> Integer -> OrderCompareType Precision Integer
lessThan Precision
p Integer
i = Precision -> Precision -> OrderCompareType Precision Precision
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan Precision
p (Integer -> Precision
prec Integer
i)
leq :: Precision -> Integer -> OrderCompareType Precision Integer
leq Precision
p Integer
i = Precision -> Precision -> OrderCompareType Precision Precision
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq Precision
p (Integer -> Precision
prec Integer
i)
instance HasOrderAsymmetric Integer Precision where
lessThan :: Integer -> Precision -> OrderCompareType Integer Precision
lessThan Integer
i Precision
p = Precision -> Precision -> OrderCompareType Precision Precision
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan (Integer -> Precision
prec Integer
i) Precision
p
leq :: Integer -> Precision -> OrderCompareType Integer Precision
leq Integer
i Precision
p = Precision -> Precision -> OrderCompareType Precision Precision
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq (Integer -> Precision
prec Integer
i) Precision
p
instance HasEqAsymmetric Precision Int where
equalTo :: Precision -> Int -> EqCompareType Precision Int
equalTo Precision
p Int
i = Precision -> Precision -> EqCompareType Precision Precision
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo Precision
p (Integer -> Precision
prec (Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
i))
instance HasEqAsymmetric Int Precision where
equalTo :: Int -> Precision -> EqCompareType Int Precision
equalTo Int
i Precision
p = Precision -> Precision -> EqCompareType Precision Precision
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo (Integer -> Precision
prec (Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
i)) Precision
p
instance HasOrderAsymmetric Precision Int where
lessThan :: Precision -> Int -> OrderCompareType Precision Int
lessThan Precision
p Int
i = Precision -> Precision -> OrderCompareType Precision Precision
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan Precision
p (Integer -> Precision
prec (Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
i))
leq :: Precision -> Int -> OrderCompareType Precision Int
leq Precision
p Int
i = Precision -> Precision -> OrderCompareType Precision Precision
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq Precision
p (Integer -> Precision
prec (Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
i))
instance HasOrderAsymmetric Int Precision where
lessThan :: Int -> Precision -> OrderCompareType Int Precision
lessThan Int
i Precision
p = Precision -> Precision -> OrderCompareType Precision Precision
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
lessThan (Integer -> Precision
prec (Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
i)) Precision
p
leq :: Int -> Precision -> OrderCompareType Int Precision
leq Int
i Precision
p = Precision -> Precision -> OrderCompareType Precision Precision
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
leq (Integer -> Precision
prec (Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
i)) Precision
p
instance CanAddAsymmetric Precision Precision
instance CanAddAsymmetric Integer Precision where
type AddType Integer Precision = Precision
add :: Integer -> Precision -> AddType Integer Precision
add Integer
n (Precision Integer
p) = Integer -> Precision
prec (Integer
n Integer -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
p)
instance CanAddAsymmetric Precision Integer where
type AddType Precision Integer = Precision
add :: Precision -> Integer -> AddType Precision Integer
add (Precision Integer
p) Integer
n = Integer -> Precision
prec (Integer
n Integer -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
p)
instance CanMulAsymmetric Precision Precision
instance CanMulAsymmetric Integer Precision where
type MulType Integer Precision = Precision
mul :: Integer -> Precision -> MulType Integer Precision
mul Integer
n (Precision Integer
p) = Integer -> Precision
prec (Integer
n Integer -> Integer -> MulType Integer Integer
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Integer
p)
instance CanMulAsymmetric Precision Integer where
type MulType Precision Integer = Precision
mul :: Precision -> Integer -> MulType Precision Integer
mul (Precision Integer
p) Integer
n = Integer -> Precision
prec (Integer
n Integer -> Integer -> MulType Integer Integer
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Integer
p)
class HasPrecision t where
getPrecision :: t -> Precision
class CanSetPrecision t where
setPrecision :: Precision -> t -> t
instance HasPrecision t => HasPrecision (Complex t) where
getPrecision :: Complex t -> Precision
getPrecision (t
a :+ t
i) =
(t -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision t
a) Precision -> Precision -> MinMaxType Precision Precision
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`min` (t -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision t
i)
instance CanSetPrecision t => CanSetPrecision (Complex t) where
setPrecision :: Precision -> Complex t -> Complex t
setPrecision Precision
p (t
a :+ t
i) =
(Precision -> t -> t
forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
p t
a) t -> t -> Complex t
forall a. a -> a -> Complex a
:+ (Precision -> t -> t
forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
p t
i)
instance HasPrecision t => HasPrecision (Maybe t) where
getPrecision :: Maybe t -> Precision
getPrecision (Just t
v) = t -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision t
v
getPrecision Maybe t
Nothing = Precision
defaultPrecision
instance CanSetPrecision t => CanSetPrecision (Maybe t) where
setPrecision :: Precision -> Maybe t -> Maybe t
setPrecision Precision
p = (t -> t) -> Maybe t -> Maybe t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Precision -> t -> t
forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
p)
instance HasPrecision Bool where
getPrecision :: Bool -> Precision
getPrecision Bool
_ = Precision
defaultPrecision
instance CanSetPrecision Bool where
setPrecision :: Precision -> Bool -> Bool
setPrecision Precision
_ = Bool -> Bool
forall a. a -> a
id
instance HasPrecision t => HasPrecision (CollectErrors es t) where
getPrecision :: CollectErrors es t -> Precision
getPrecision CollectErrors es t
vCE =
case CollectErrors es t -> Maybe t
forall es v. CollectErrors es v -> Maybe v
getMaybeValue CollectErrors es t
vCE of
Just t
v -> t -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision t
v
Maybe t
_ -> Precision
defaultPrecision
instance CanSetPrecision t => CanSetPrecision (CollectErrors es t) where
setPrecision :: Precision -> CollectErrors es t -> CollectErrors es t
setPrecision Precision
p = (t -> t) -> CollectErrors es t -> CollectErrors es t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Precision -> t -> t
forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
p)
lowerPrecisionIfAbove :: (HasPrecision t, CanSetPrecision t) => Precision -> t -> t
lowerPrecisionIfAbove :: Precision -> t -> t
lowerPrecisionIfAbove Precision
p t
x
| t -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision t
x Precision -> Precision -> OrderCompareType Precision Precision
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Precision
p = Precision -> t -> t
forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
p t
x
| Bool
otherwise = t
x
raisePrecisionIfBelow :: (HasPrecision t, CanSetPrecision t) => Precision -> t -> t
raisePrecisionIfBelow :: Precision -> t -> t
raisePrecisionIfBelow Precision
p t
x
| t -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision t
x Precision -> Precision -> OrderCompareType Precision Precision
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Precision
p = Precision -> t -> t
forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
p t
x
| Bool
otherwise = t
x
specCanSetPrecision ::
(HasPrecision t, CanSetPrecision t, CanTestFinite t, Arbitrary t, Show t, Testable prop)
=>
(T t) -> (t -> t -> prop) -> Spec
specCanSetPrecision :: T t -> (t -> t -> prop) -> Spec
specCanSetPrecision (T String
typeName :: T t) t -> t -> prop
check =
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String -> ShowS
forall r. PrintfType r => String -> r
printf String
"CanSetPrecision %s" String
typeName) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"set then get" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> Precision -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Precision -> Property) -> Property)
-> (t -> Precision -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) (Precision
p :: Precision) ->
t -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t
x Bool -> Bool -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
let xP :: t
xP = Precision -> t -> t
forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
p t
x in
Precision
p Precision -> Precision -> EqCompareType Precision Precision
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== t -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision t
xP
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"setPrecision x ~ x" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> Precision -> prop) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Precision -> prop) -> Property)
-> (t -> Precision -> prop) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) (Precision
p :: Precision) ->
let xP :: t
xP = Precision -> t -> t
forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
p t
x in
t -> t -> prop
check t
xP t
x
maximumPrecision :: Precision
maximumPrecision :: Precision
maximumPrecision = Integer -> Precision
Precision Integer
5000000
defaultPrecision :: Precision
defaultPrecision :: Precision
defaultPrecision = Integer -> Precision
Precision Integer
100
standardPrecisions :: Precision -> [Precision]
standardPrecisions :: Precision -> [Precision]
standardPrecisions (Precision Integer
initPrec0) =
(Integer -> Precision) -> [Integer] -> [Precision]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Precision
Precision (Integer -> Precision)
-> (Integer -> Integer) -> Integer -> Precision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
MinMaxType Integer Integer
initPrec)) ([Integer] -> [Precision]) -> [Integer] -> [Precision]
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> [Integer]
aux Integer
0 (Integer -> Integer -> MinMaxType Integer Integer
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max Integer
2 (Integer
MinMaxType Integer Integer
initPrec Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`P.div` Integer
16))
where
initPrec :: MinMaxType Integer Integer
initPrec = Integer -> Integer -> MinMaxType Integer Integer
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max Integer
2 Integer
initPrec0
aux :: Integer -> Integer -> [Integer]
aux Integer
j Integer
j'
| Integer -> Precision
Precision Integer
j Precision -> Precision -> OrderCompareType Precision Precision
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
<= Precision
maximumPrecision = Integer
j Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: (Integer -> Integer -> [Integer]
aux Integer
j' (Integer
jInteger -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+Integer
j'))
| Bool
otherwise = []
precisionTimes2 :: Precision -> Precision
precisionTimes2 :: Precision -> Precision
precisionTimes2 (Precision Integer
p) = Integer -> Precision
Precision (Integer
2Integer -> Integer -> MulType Integer Integer
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*Integer
p)
iterateUntilOK ::
Precision ->
(a -> Bool) ->
(Precision -> a) ->
[(Precision, a)]
iterateUntilOK :: Precision -> (a -> Bool) -> (Precision -> a) -> [(Precision, a)]
iterateUntilOK Precision
initPrec a -> Bool
isOK Precision -> a
fn =
[Precision] -> [(Precision, a)]
stopWhenAccurate [Precision]
ps
where
ps :: [Precision]
ps = Precision -> [Precision]
standardPrecisions Precision
initPrec
stopWhenAccurate :: [Precision] -> [(Precision, a)]
stopWhenAccurate [] = []
stopWhenAccurate (Precision
p : [Precision]
rest)
| a -> Bool
isOK a
result = [(Precision
p, a
result)]
| Bool
otherwise = (Precision
p, a
result) (Precision, a) -> [(Precision, a)] -> [(Precision, a)]
forall a. a -> [a] -> [a]
: [Precision] -> [(Precision, a)]
stopWhenAccurate [Precision]
rest
where
result :: a
result = Precision -> a
fn Precision
p
class ConvertibleWithPrecision t1 t2 where
safeConvertP :: Precision -> t1 -> ConvertResult t2
convertP :: (ConvertibleWithPrecision t1 t2) => Precision -> t1 -> t2
convertP :: Precision -> t1 -> t2
convertP Precision
p t1
a =
case Precision -> t1 -> ConvertResult t2
forall t1 t2.
ConvertibleWithPrecision t1 t2 =>
Precision -> t1 -> ConvertResult t2
safeConvertP Precision
p t1
a of
Right t2
v -> t2
v
Left ConvertError
err -> String -> t2
forall a. HasCallStack => String -> a
error (ConvertError -> String
forall a. Show a => a -> String
show ConvertError
err)
convertPFirst ::
(ConvertibleWithPrecision t1 t2, HasPrecision t2) =>
(t2 -> t2 -> c) -> (t1 -> t2 -> c)
convertPFirst :: (t2 -> t2 -> c) -> t1 -> t2 -> c
convertPFirst = (t1 -> t2 -> t2) -> (t2 -> t2 -> c) -> t1 -> t2 -> c
forall a b c. (a -> b -> b) -> (b -> b -> c) -> a -> b -> c
convertFirstUsing (\ t1
q t2
b -> Precision -> t1 -> t2
forall t1 t2.
ConvertibleWithPrecision t1 t2 =>
Precision -> t1 -> t2
convertP (t2 -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision t2
b) t1
q)
convertPSecond ::
(ConvertibleWithPrecision t2 t1, HasPrecision t1) =>
(t1 -> t1 -> c) -> (t1 -> t2 -> c)
convertPSecond :: (t1 -> t1 -> c) -> t1 -> t2 -> c
convertPSecond = (t1 -> t2 -> t1) -> (t1 -> t1 -> c) -> t1 -> t2 -> c
forall a b c. (a -> b -> a) -> (a -> a -> c) -> a -> b -> c
convertSecondUsing (\ t1
b t2
q -> Precision -> t2 -> t1
forall t1 t2.
ConvertibleWithPrecision t1 t2 =>
Precision -> t1 -> t2
convertP (t1 -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision t1
b) t2
q)
instance Arbitrary Precision where
arbitrary :: Gen Precision
arbitrary =
(Int -> Gen Precision) -> Gen Precision
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen Precision) -> Gen Precision)
-> (Int -> Gen Precision) -> Gen Precision
forall a b. (a -> b) -> a -> b
$ \Int
size -> (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
4Integer -> Integer -> MulType Integer Integer
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*(Int
sizeInt -> Integer -> AddType Int Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+Integer
1),Integer
10Integer -> Integer -> MulType Integer Integer
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*(Int
sizeInt -> Integer -> AddType Int Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+Integer
1)) Gen Integer -> (Integer -> Gen Precision) -> Gen Precision
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Precision -> Gen Precision
forall (m :: * -> *) a. Monad m => a -> m a
return (Precision -> Gen Precision)
-> (Integer -> Precision) -> Integer -> Gen Precision
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Precision
prec
$(declForTypes
[[t| Bool |], [t| Integer |], [t| Int |], [t| Rational |], [t| Double |]]
(\ t -> [d|
instance (ConvertibleWithPrecision $t t, CanBeErrors es) => ConvertibleWithPrecision $t (CollectErrors es t) where
safeConvertP p = fmap pure . safeConvertP p
|]))