{-|
    Module      :  AERN2.MP.Accuracy
    Description :  Rough accuracy of an enclosure
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

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

    A type for measuring the accuracy of an enclosing set,
    roughly corresponding to the maximum absolute error in some distance metric
    approximately measured in bits.
-}
module AERN2.MP.Accuracy
    (Accuracy(NoInformation, Exact), bits, fromAccuracy,
     HasAccuracy(..),
     ac2prec,
     iterateUntilAccurate,
     convergentList2seqByAccuracy,
     seqByPrecision2seqByAccuracy,
     setPrecisionAtLeastAccuracy,
     ShowWithAccuracy(..),
     HasApproximate(..))
where

import MixedTypesNumPrelude
import qualified Prelude as P

import Control.CollectErrors

import Data.Complex

-- import Test.Hspec
import Test.QuickCheck ( Arbitrary(arbitrary), frequency )

import AERN2.Norm
import AERN2.Kleenean
import AERN2.MP.Precision

{- example -}

_example1 :: Accuracy
_example1 :: Accuracy
_example1 = Integer
1 Integer -> Accuracy -> AddType Integer Accuracy
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
2Integer -> Accuracy -> MulType Integer Accuracy
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*(Integer -> Accuracy
forall t. ConvertibleExactly t Accuracy => t -> Accuracy
bits Integer
100)

{-| A non-negative Double value to serve as an error bound. Arithmetic is rounded towards +infinity. -}
data Accuracy = NoInformation | Bits { Accuracy -> Integer
fromAccuracy :: Integer } | Exact
  deriving (Accuracy -> Accuracy -> Bool
(Accuracy -> Accuracy -> Bool)
-> (Accuracy -> Accuracy -> Bool) -> Eq Accuracy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Accuracy -> Accuracy -> Bool
$c/= :: Accuracy -> Accuracy -> Bool
== :: Accuracy -> Accuracy -> Bool
$c== :: Accuracy -> Accuracy -> Bool
P.Eq, Eq Accuracy
Eq Accuracy
-> (Accuracy -> Accuracy -> Ordering)
-> (Accuracy -> Accuracy -> Bool)
-> (Accuracy -> Accuracy -> Bool)
-> (Accuracy -> Accuracy -> Bool)
-> (Accuracy -> Accuracy -> Bool)
-> (Accuracy -> Accuracy -> Accuracy)
-> (Accuracy -> Accuracy -> Accuracy)
-> Ord Accuracy
Accuracy -> Accuracy -> Bool
Accuracy -> Accuracy -> Ordering
Accuracy -> Accuracy -> Accuracy
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 :: Accuracy -> Accuracy -> Accuracy
$cmin :: Accuracy -> Accuracy -> Accuracy
max :: Accuracy -> Accuracy -> Accuracy
$cmax :: Accuracy -> Accuracy -> Accuracy
>= :: Accuracy -> Accuracy -> Bool
$c>= :: Accuracy -> Accuracy -> Bool
> :: Accuracy -> Accuracy -> Bool
$c> :: Accuracy -> Accuracy -> Bool
<= :: Accuracy -> Accuracy -> Bool
$c<= :: Accuracy -> Accuracy -> Bool
< :: Accuracy -> Accuracy -> Bool
$c< :: Accuracy -> Accuracy -> Bool
compare :: Accuracy -> Accuracy -> Ordering
$ccompare :: Accuracy -> Accuracy -> Ordering
$cp1Ord :: Eq Accuracy
P.Ord)

instance Arbitrary Accuracy where
  arbitrary :: Gen Accuracy
arbitrary =
    [(Int, Gen Accuracy)] -> Gen Accuracy
forall a. [(Int, Gen a)] -> Gen a
frequency
      [(Integer -> Int
forall t. CanBeInt t => t -> Int
int Integer
1, Accuracy -> Gen Accuracy
forall (f :: * -> *) a. Applicative f => a -> f a
pure Accuracy
Exact),
       (Integer -> Int
forall t. CanBeInt t => t -> Int
int Integer
1, Accuracy -> Gen Accuracy
forall (f :: * -> *) a. Applicative f => a -> f a
pure Accuracy
NoInformation),
       (Integer -> Int
forall t. CanBeInt t => t -> Int
int Integer
8, Integer -> Accuracy
Bits (Integer -> Accuracy) -> Gen Integer -> Gen Accuracy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary)]

instance Enum Accuracy where
    fromEnum :: Accuracy -> Int
fromEnum Accuracy
NoInformation = Int
forall a. Bounded a => a
minBound
    fromEnum (Bits Integer
i) = Integer -> Int
forall t. CanBeInt t => t -> Int
int Integer
i
    fromEnum Accuracy
Exact = Int
forall a. Bounded a => a
maxBound
    toEnum :: Int -> Accuracy
toEnum Int
i = Integer -> Accuracy
Bits (Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
i)

instance Bounded Accuracy where
    minBound :: Accuracy
minBound = Accuracy
NoInformation
    maxBound :: Accuracy
maxBound = Accuracy
Exact

instance ConvertibleExactly Integer Accuracy where
  safeConvertExactly :: Integer -> ConvertResult Accuracy
safeConvertExactly = Accuracy -> ConvertResult Accuracy
forall a b. b -> Either a b
Right (Accuracy -> ConvertResult Accuracy)
-> (Integer -> Accuracy) -> Integer -> ConvertResult Accuracy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Accuracy
Bits
instance ConvertibleExactly Int Accuracy where
  safeConvertExactly :: Int -> ConvertResult Accuracy
safeConvertExactly = Accuracy -> ConvertResult Accuracy
forall a b. b -> Either a b
Right (Accuracy -> ConvertResult Accuracy)
-> (Int -> Accuracy) -> Int -> ConvertResult Accuracy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Accuracy
Bits (Integer -> Accuracy) -> (Int -> Integer) -> Int -> Accuracy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer
instance ConvertibleExactly Precision Accuracy where
  safeConvertExactly :: Precision -> ConvertResult Accuracy
safeConvertExactly = Accuracy -> ConvertResult Accuracy
forall a b. b -> Either a b
Right (Accuracy -> ConvertResult Accuracy)
-> (Precision -> Accuracy) -> Precision -> ConvertResult Accuracy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Accuracy
Bits (Integer -> Accuracy)
-> (Precision -> Integer) -> Precision -> Accuracy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Precision -> Integer
forall t. CanBeInteger t => t -> Integer
integer
instance ConvertibleExactly NormLog Accuracy where
  safeConvertExactly :: NormLog -> ConvertResult Accuracy
safeConvertExactly (NormBits Integer
b) = Accuracy -> ConvertResult Accuracy
forall a b. b -> Either a b
Right (Accuracy -> ConvertResult Accuracy)
-> Accuracy -> ConvertResult Accuracy
forall a b. (a -> b) -> a -> b
$ Integer -> Accuracy
forall t. ConvertibleExactly t Accuracy => t -> Accuracy
bits (-Integer
b)
  safeConvertExactly NormLog
NormZero = Accuracy -> ConvertResult Accuracy
forall a b. b -> Either a b
Right Accuracy
Exact

bits :: (ConvertibleExactly t Accuracy) => t -> Accuracy
bits :: t -> Accuracy
bits = t -> Accuracy
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly

instance Show Accuracy where
    show :: Accuracy -> String
show (Accuracy
NoInformation) = String
"NoInformation"
    show (Bits Integer
a) = String
"bits " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
a
    show (Accuracy
Exact) = String
"Exact"

instance HasEqAsymmetric Accuracy Accuracy
instance HasOrderAsymmetric Accuracy Accuracy
instance CanMinMaxAsymmetric Accuracy Accuracy

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

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

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

instance CanNeg Accuracy where
  negate :: Accuracy -> NegType Accuracy
negate Accuracy
NoInformation = NegType Accuracy
Accuracy
Exact
  negate Accuracy
Exact = NegType Accuracy
Accuracy
NoInformation
  negate (Bits Integer
a) = Integer -> Accuracy
Bits (-Integer
a)

instance CanAddAsymmetric Accuracy Accuracy where
   add :: Accuracy -> Accuracy -> AddType Accuracy Accuracy
add Accuracy
NoInformation Accuracy
_ = AddType Accuracy Accuracy
Accuracy
NoInformation
   add Accuracy
_ Accuracy
NoInformation = AddType Accuracy Accuracy
Accuracy
NoInformation
   add (Bits Integer
a) (Bits Integer
b) = Integer -> Accuracy
Bits (Integer -> Accuracy) -> Integer -> Accuracy
forall a b. (a -> b) -> a -> b
$ Integer
a Integer -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
b
   add Accuracy
Exact Accuracy
_ = AddType Accuracy Accuracy
Accuracy
Exact
   add Accuracy
_ Accuracy
Exact = AddType Accuracy Accuracy
Accuracy
Exact

instance CanSub Accuracy Accuracy

--instance CanMulAsymmetric Accuracy Accuracy where
--    mulA NoInformation _ = NoInformation
--    mulA _ NoInformation = NoInformation
--    mulA (Bits a) (Bits b) = Bits $ a * b
--    mulA Exact _ = Exact
--    mulA _ Exact = Exact

instance CanMulAsymmetric Accuracy Integer where
    type MulType Accuracy Integer = Accuracy
    mul :: Accuracy -> Integer -> MulType Accuracy Integer
mul Accuracy
NoInformation Integer
_ = MulType Accuracy Integer
Accuracy
NoInformation
    mul (Bits Integer
a) Integer
i = Integer -> Accuracy
Bits (Integer -> Accuracy) -> Integer -> Accuracy
forall a b. (a -> b) -> a -> b
$ Integer
a Integer -> Integer -> MulType Integer Integer
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* Integer
i
    mul Accuracy
Exact Integer
_ = MulType Accuracy Integer
Accuracy
Exact

instance CanMulAsymmetric Integer Accuracy where
    type MulType Integer Accuracy = Accuracy
    mul :: Integer -> Accuracy -> MulType Integer Accuracy
mul Integer
i Accuracy
a = Accuracy -> Integer -> MulType Accuracy Integer
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul Accuracy
a Integer
i

instance CanAddAsymmetric Accuracy Integer where
    type AddType Accuracy Integer = Accuracy
    add :: Accuracy -> Integer -> AddType Accuracy Integer
add Accuracy
NoInformation Integer
_ = AddType Accuracy Integer
Accuracy
NoInformation
    add (Bits Integer
a) Integer
i = Integer -> Accuracy
Bits (Integer -> Accuracy) -> Integer -> Accuracy
forall a b. (a -> b) -> a -> b
$ Integer
a Integer -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
i
    add Accuracy
Exact Integer
_ = AddType Accuracy Integer
Accuracy
Exact

instance CanAddAsymmetric Integer Accuracy where
    type AddType Integer Accuracy = Accuracy
    add :: Integer -> Accuracy -> AddType Integer Accuracy
add Integer
i Accuracy
a = Accuracy -> Integer -> AddType Accuracy Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add Accuracy
a Integer
i

instance CanSub Accuracy Integer where
    type SubType Accuracy Integer = Accuracy
    sub :: Accuracy -> Integer -> SubType Accuracy Integer
sub Accuracy
NoInformation Integer
_ = SubType Accuracy Integer
Accuracy
NoInformation
    sub (Bits Integer
a) Integer
i = Integer -> Accuracy
Bits (Integer -> Accuracy) -> Integer -> Accuracy
forall a b. (a -> b) -> a -> b
$ Integer
a Integer -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
i
    sub Accuracy
Exact Integer
_ = SubType Accuracy Integer
Accuracy
Exact

class HasAccuracy a where
  getAccuracy :: a -> Accuracy
  {-| Return accuracy, except when the element is Exact, return its nominal Precision dressed as Accuracy.
      This function is useful when we have a convergent sequence where all elements happen to be
      actually equal to the limit and we need the property that the sequence elements keep improving.
  -}
  getFiniteAccuracy :: a -> Accuracy
  default getFiniteAccuracy :: (HasPrecision a) => a -> Accuracy
  getFiniteAccuracy a
b =
      case a -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getAccuracy a
b of
          Accuracy
Exact -> Precision -> Accuracy
forall t. ConvertibleExactly t Accuracy => t -> Accuracy
bits (Precision -> Accuracy) -> Precision -> Accuracy
forall a b. (a -> b) -> a -> b
$ a -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision a
b
          Accuracy
a -> Accuracy
a

instance (HasAccuracy a, CanBeErrors es) => HasAccuracy (CollectErrors es a) where
  getAccuracy :: CollectErrors es a -> Accuracy
getAccuracy (CollectErrors Maybe a
ma es
es) =
    case Maybe a
ma of
      Just a
a | Bool -> NegType Bool
forall t. CanNeg t => t -> NegType t
not (es -> Bool
forall es. CanTestErrorsCertain es => es -> Bool
hasCertainError es
es) -> a -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getAccuracy a
a
      Maybe a
_ -> Accuracy
NoInformation
  getFiniteAccuracy :: CollectErrors es a -> Accuracy
getFiniteAccuracy (CollectErrors Maybe a
ma es
es) = 
    case Maybe a
ma of
      Just a
a | Bool -> NegType Bool
forall t. CanNeg t => t -> NegType t
not (es -> Bool
forall es. CanTestErrorsCertain es => es -> Bool
hasCertainError es
es) -> a -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getFiniteAccuracy a
a
      Maybe a
_ -> Accuracy
NoInformation

instance HasAccuracy Int where getAccuracy :: Int -> Accuracy
getAccuracy Int
_ = Accuracy
Exact; getFiniteAccuracy :: Int -> Accuracy
getFiniteAccuracy Int
_ = Accuracy
NoInformation
instance HasAccuracy Integer where getAccuracy :: Integer -> Accuracy
getAccuracy Integer
_ = Accuracy
Exact; getFiniteAccuracy :: Integer -> Accuracy
getFiniteAccuracy Integer
_ = Accuracy
NoInformation
instance HasAccuracy Rational where getAccuracy :: Rational -> Accuracy
getAccuracy Rational
_ = Accuracy
Exact; getFiniteAccuracy :: Rational -> Accuracy
getFiniteAccuracy Rational
_ = Accuracy
NoInformation
instance HasAccuracy Bool where getAccuracy :: Bool -> Accuracy
getAccuracy Bool
_ = Accuracy
Exact; getFiniteAccuracy :: Bool -> Accuracy
getFiniteAccuracy Bool
_ = Accuracy
NoInformation
instance HasAccuracy Kleenean where getAccuracy :: Kleenean -> Accuracy
getAccuracy Kleenean
_ = Accuracy
Exact; getFiniteAccuracy :: Kleenean -> Accuracy
getFiniteAccuracy Kleenean
_ = Accuracy
NoInformation

instance HasAccuracy t => HasAccuracy (Complex t) where
  getAccuracy :: Complex t -> Accuracy
getAccuracy (t
a :+ t
i) =
    (t -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getAccuracy t
a) Accuracy -> Accuracy -> MinMaxType Accuracy Accuracy
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`min` (t -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getAccuracy t
i)
  getFiniteAccuracy :: Complex t -> Accuracy
getFiniteAccuracy (t
a :+ t
i) =
    (t -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getFiniteAccuracy t
a) Accuracy -> Accuracy -> MinMaxType Accuracy Accuracy
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`min` (t -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getFiniteAccuracy t
i)
  
instance HasAccuracy t => HasAccuracy [t] where
  getAccuracy :: [t] -> Accuracy
getAccuracy [t]
xs = (Accuracy -> Accuracy -> Accuracy)
-> Accuracy -> [Accuracy] -> Accuracy
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Accuracy -> Accuracy -> Accuracy
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min Accuracy
Exact ([Accuracy] -> Accuracy) -> [Accuracy] -> Accuracy
forall a b. (a -> b) -> a -> b
$ (t -> Accuracy) -> [t] -> [Accuracy]
forall a b. (a -> b) -> [a] -> [b]
map t -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getAccuracy [t]
xs
  getFiniteAccuracy :: [t] -> Accuracy
getFiniteAccuracy [t]
xs = (Accuracy -> Accuracy -> Accuracy)
-> Accuracy -> [Accuracy] -> Accuracy
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Accuracy -> Accuracy -> Accuracy
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min Accuracy
Exact ([Accuracy] -> Accuracy) -> [Accuracy] -> Accuracy
forall a b. (a -> b) -> a -> b
$ (t -> Accuracy) -> [t] -> [Accuracy]
forall a b. (a -> b) -> [a] -> [b]
map t -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getFiniteAccuracy [t]
xs

instance HasAccuracy t => HasAccuracy (Maybe t) where
  getAccuracy :: Maybe t -> Accuracy
getAccuracy (Just t
x) = t -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getAccuracy t
x
  getAccuracy Maybe t
_ = Accuracy
NoInformation
  getFiniteAccuracy :: Maybe t -> Accuracy
getFiniteAccuracy (Just t
x) = t -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getFiniteAccuracy t
x
  getFiniteAccuracy Maybe t
_ = Accuracy
NoInformation

iterateUntilAccurate ::
  (HasAccuracy t) =>
  Accuracy ->
  (Precision -> Maybe t) ->
  [(Precision, Maybe t)]
iterateUntilAccurate :: Accuracy -> (Precision -> Maybe t) -> [(Precision, Maybe t)]
iterateUntilAccurate Accuracy
ac =
  Precision
-> (Maybe t -> Bool)
-> (Precision -> Maybe t)
-> [(Precision, Maybe t)]
forall a.
Precision -> (a -> Bool) -> (Precision -> a) -> [(Precision, a)]
iterateUntilOK (Accuracy -> Precision
ac2prec Accuracy
ac) ((Maybe t -> Bool)
 -> (Precision -> Maybe t) -> [(Precision, Maybe t)])
-> (Maybe t -> Bool)
-> (Precision -> Maybe t)
-> [(Precision, Maybe t)]
forall a b. (a -> b) -> a -> b
$ \Maybe t
maybeResult ->
    case Maybe t
maybeResult of
      Just t
result -> t -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getAccuracy t
result Accuracy -> Accuracy -> OrderCompareType Accuracy Accuracy
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Accuracy
ac
      Maybe t
_ -> Bool
False

ac2prec :: Accuracy -> Precision
ac2prec :: Accuracy -> Precision
ac2prec Accuracy
ac =
  case Accuracy
ac of
    Bits Integer
b -> Integer -> Precision
prec (Integer -> Integer -> MinMaxType Integer Integer
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max Integer
2 (Integer -> MinMaxType Integer Integer)
-> Integer -> MinMaxType Integer Integer
forall a b. (a -> b) -> a -> b
$ Integer
b Integer -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
50)
    Accuracy
_ -> Integer -> Precision
prec Integer
100

seqByPrecision2seqByAccuracy ::
    (HasAccuracy t) =>
    (Precision -> t) -> (Accuracy -> t)
seqByPrecision2seqByAccuracy :: (Precision -> t) -> Accuracy -> t
seqByPrecision2seqByAccuracy Precision -> t
seqByPrecision Accuracy
ac =
    [t] -> Accuracy -> t
forall t. HasAccuracy t => [t] -> Accuracy -> t
convergentList2seqByAccuracy [t]
list Accuracy
ac
    where
    list :: [t]
list =
      (Precision -> t) -> [Precision] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map Precision -> t
seqByPrecision ([Precision] -> [t]) -> [Precision] -> [t]
forall a b. (a -> b) -> a -> b
$ (Precision -> Bool) -> [Precision] -> [Precision]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Accuracy -> Precision -> Bool
lowPrec Accuracy
ac) (Precision -> [Precision]
standardPrecisions (Accuracy -> Precision
ac2prec Accuracy
ac))
    lowPrec :: Accuracy -> Precision -> Bool
lowPrec Accuracy
Exact Precision
_ = Bool
False
    lowPrec Accuracy
_ Precision
p = Precision -> Accuracy
forall t. ConvertibleExactly t Accuracy => t -> Accuracy
bits Precision
p Accuracy -> Accuracy -> OrderCompareType Accuracy Accuracy
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Accuracy
ac

convergentList2seqByAccuracy :: (HasAccuracy t) => [t] -> (Accuracy -> t)
convergentList2seqByAccuracy :: [t] -> Accuracy -> t
convergentList2seqByAccuracy [t]
list Accuracy
ac = [t] -> t
findAccurate [t]
list
  where
  findAccurate :: [t] -> t
findAccurate [] =
    String -> t
forall a. HasCallStack => String -> a
error String
"convergentList2seqByAccuracy: the sequence either converges too slowly or it does not converge"
  findAccurate (t
b : [t]
rest)
    | t -> Accuracy
forall a. HasAccuracy a => a -> Accuracy
getAccuracy t
b Accuracy -> Accuracy -> OrderCompareType Accuracy Accuracy
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
>= Accuracy
ac = t
b
    | Bool
otherwise = [t] -> t
findAccurate [t]
rest

{-|
    Change the precision so that
    it is at least as high as the supplied accuracy
    (assuming the accuracy is finite).
-}
setPrecisionAtLeastAccuracy :: (HasPrecision t, CanSetPrecision t) => Accuracy -> t -> t
setPrecisionAtLeastAccuracy :: Accuracy -> t -> t
setPrecisionAtLeastAccuracy Accuracy
acc t
b
    | Precision
p_b Precision -> Precision -> OrderCompareType Precision Precision
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Precision
p_acc = Precision -> t -> t
forall t. CanSetPrecision t => Precision -> t -> t
setPrecision Precision
p_acc t
b
    | Bool
otherwise = t
b
    where
    p_acc :: Precision
p_acc =
        case Accuracy
acc of
          Accuracy
Exact -> String -> Precision
forall a. HasCallStack => String -> a
error (String -> Precision) -> String -> Precision
forall a b. (a -> b) -> a -> b
$ String
"setPrecisionAtLeastAccuracy: cannot match Exact accuracy"
          Accuracy
NoInformation -> Precision
p_b
          Accuracy
_ -> Integer -> Precision
prec (Integer -> Precision) -> Integer -> Precision
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> MinMaxType Integer Integer
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max Integer
2 (Accuracy -> Integer
fromAccuracy Accuracy
acc)
    p_b :: Precision
p_b = t -> Precision
forall t. HasPrecision t => t -> Precision
getPrecision t
b

class ShowWithAccuracy t where
  showWithAccuracy :: Accuracy -> t -> String

{-| An unsafe approximation of an enclosure or exact value,
    useful mainly for showing something brief and readable to humans.
-}
class HasApproximate t where
    type Approximate t
    getApproximate :: Accuracy -> t -> (Approximate t)