module Test.Falsify.Range (
Range
, between
, withOrigin
, skewedBy
, origin
, ProperFraction(..)
, Precision(..)
, constant
, fromProperFraction
, towards
, eval
) where
import Data.List (minimumBy)
import Data.Ord
import Test.Falsify.Internal.Range
import Data.Bits
constant :: a -> Range a
constant :: forall a. a -> Range a
constant = forall a. a -> Range a
Constant
fromProperFraction :: Precision -> (ProperFraction -> a) -> Range a
fromProperFraction :: forall a. Precision -> (ProperFraction -> a) -> Range a
fromProperFraction = forall a. Precision -> (ProperFraction -> a) -> Range a
FromProperFraction
towards :: a -> [Range a] -> Range a
towards :: forall a. a -> [Range a] -> Range a
towards = forall a. a -> [Range a] -> Range a
Towards
between :: forall a. (Integral a, FiniteBits a) => (a, a) -> Range a
between :: forall a. (Integral a, FiniteBits a) => (a, a) -> Range a
between = forall a. (FiniteBits a, Integral a) => Double -> (a, a) -> Range a
skewedBy Double
0
withOrigin :: (Integral a, FiniteBits a) => (a, a) -> a -> Range a
withOrigin :: forall a. (Integral a, FiniteBits a) => (a, a) -> a -> Range a
withOrigin (a
x, a
y) a
o
| Bool -> Bool
not Bool
originInBounds
= forall a. HasCallStack => [Char] -> a
error [Char]
"withOrigin: origin not within bounds"
| a
x forall a. Eq a => a -> a -> Bool
== a
y
= forall a. a -> Range a
Constant a
x
| a
o forall a. Eq a => a -> a -> Bool
== a
x
= forall a. (Integral a, FiniteBits a) => (a, a) -> Range a
between (a
x, a
y)
| a
o forall a. Eq a => a -> a -> Bool
== a
y
= forall a. (Integral a, FiniteBits a) => (a, a) -> Range a
between (a
y, a
x)
| Bool
otherwise =
forall a. a -> [Range a] -> Range a
towards a
o [
forall a. (Integral a, FiniteBits a) => (a, a) -> Range a
between (a
o, a
y)
, forall a. (Integral a, FiniteBits a) => (a, a) -> Range a
between (a
o, a
x)
]
where
originInBounds :: Bool
originInBounds :: Bool
originInBounds
| a
x forall a. Ord a => a -> a -> Bool
<= a
o Bool -> Bool -> Bool
&& a
o forall a. Ord a => a -> a -> Bool
<= a
y = Bool
True
| a
y forall a. Ord a => a -> a -> Bool
<= a
o Bool -> Bool -> Bool
&& a
o forall a. Ord a => a -> a -> Bool
<= a
x = Bool
True
| Bool
otherwise = Bool
False
skewedBy :: forall a. (FiniteBits a, Integral a) => Double -> (a, a) -> Range a
skewedBy :: forall a. (FiniteBits a, Integral a) => Double -> (a, a) -> Range a
skewedBy Double
s (a
x, a
y)
| a
x forall a. Eq a => a -> a -> Bool
== a
y = forall a. a -> Range a
constant a
x
| a
x forall a. Ord a => a -> a -> Bool
< a
y = let p :: Precision
p = forall a. FiniteBits a => a -> Precision
precisionRequiredToRepresent (a
y forall a. Num a => a -> a -> a
- a
x)
in forall a. Precision -> (ProperFraction -> a) -> Range a
fromProperFraction Precision
p forall a b. (a -> b) -> a -> b
$ \(ProperFraction Double
f) -> Double -> a
roundDown Double
f
| Bool
otherwise = let p :: Precision
p = forall a. FiniteBits a => a -> Precision
precisionRequiredToRepresent (a
x forall a. Num a => a -> a -> a
- a
y)
in forall a. Precision -> (ProperFraction -> a) -> Range a
fromProperFraction Precision
p forall a b. (a -> b) -> a -> b
$ \(ProperFraction Double
f) -> Double -> a
roundUp Double
f
where
x', y' :: Double
x' :: Double
x' = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x
y' :: Double
y' = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
y
roundDown, roundUp :: Double -> a
roundDown :: Double -> a
roundDown Double
f = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ Double
x' forall a. Num a => a -> a -> a
+ Double -> Double
skew Double
f forall a. Num a => a -> a -> a
* (Double
y' forall a. Num a => a -> a -> a
- Double
x' forall a. Num a => a -> a -> a
+ Double
1)
roundUp :: Double -> a
roundUp Double
f = forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall a b. (a -> b) -> a -> b
$ Double
x' forall a. Num a => a -> a -> a
- Double -> Double
skew Double
f forall a. Num a => a -> a -> a
* (Double
x' forall a. Num a => a -> a -> a
- Double
y' forall a. Num a => a -> a -> a
+ Double
1)
pos, neg :: Double -> Double
pos :: Double -> Double
pos Double
f = Double
1 forall a. Num a => a -> a -> a
- ((Double
1 forall a. Num a => a -> a -> a
- Double
f forall a. Floating a => a -> a -> a
** (Double
s forall a. Num a => a -> a -> a
+ Double
1)) forall a. Floating a => a -> a -> a
** (Double
1 forall a. Fractional a => a -> a -> a
/ ( Double
s forall a. Num a => a -> a -> a
+ Double
1)))
neg :: Double -> Double
neg Double
f = (Double
1 forall a. Num a => a -> a -> a
- (Double
1 forall a. Num a => a -> a -> a
- Double
f) forall a. Floating a => a -> a -> a
** (Double
s forall a. Num a => a -> a -> a
+ Double
1)) forall a. Floating a => a -> a -> a
** (Double
1 forall a. Fractional a => a -> a -> a
/ (forall a. Num a => a -> a
abs Double
s forall a. Num a => a -> a -> a
+ Double
1))
skew :: Double -> Double
skew :: Double -> Double
skew | Double
s forall a. Eq a => a -> a -> Bool
== Double
0 = forall a. a -> a
id
| Double
s forall a. Ord a => a -> a -> Bool
>= Double
0 = Double -> Double
pos
| Bool
otherwise = Double -> Double
neg
precisionRequiredToRepresent :: forall a. FiniteBits a => a -> Precision
precisionRequiredToRepresent :: forall a. FiniteBits a => a -> Precision
precisionRequiredToRepresent a
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$
Int
7 forall a. Ord a => a -> a -> a
`max` (forall b. FiniteBits b => b -> Int
finiteBitSize (forall a. HasCallStack => a
undefined :: a) forall a. Num a => a -> a -> a
- forall b. FiniteBits b => b -> Int
countLeadingZeros a
x)
origin :: Range a -> a
origin :: forall a. Range a -> a
origin (Constant a
x) = a
x
origin (FromProperFraction Precision
_ ProperFraction -> a
f) = ProperFraction -> a
f (Double -> ProperFraction
ProperFraction Double
0)
origin (Towards a
o [Range a]
_) = a
o
evalTowards :: forall f a.
(Applicative f, Ord a, Num a)
=> a -> [f a] -> f a
evalTowards :: forall (f :: * -> *) a.
(Applicative f, Ord a, Num a) =>
a -> [f a] -> f a
evalTowards a
o [f a]
gens =
[a] -> a
pick forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [f a]
gens
where
pick :: [a] -> a
pick :: [a] -> a
pick [] = a
o
pick [a]
as = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing a -> a
distanceToOrigin) [a]
as
distanceToOrigin :: a -> a
distanceToOrigin :: a -> a
distanceToOrigin a
x
| a
x forall a. Ord a => a -> a -> Bool
>= a
o = a
x forall a. Num a => a -> a -> a
- a
o
| Bool
otherwise = a
o forall a. Num a => a -> a -> a
- a
x
eval :: forall f a.
(Applicative f, Ord a, Num a)
=> (Precision -> f ProperFraction) -> Range a -> f a
eval :: forall (f :: * -> *) a.
(Applicative f, Ord a, Num a) =>
(Precision -> f ProperFraction) -> Range a -> f a
eval Precision -> f ProperFraction
genFraction = Range a -> f a
go
where
go :: Range a -> f a
go :: Range a -> f a
go Range a
r =
case Range a
r of
Constant a
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
FromProperFraction Precision
p ProperFraction -> a
f -> ProperFraction -> a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Precision -> f ProperFraction
genFraction Precision
p
Towards a
o [Range a]
rs -> forall (f :: * -> *) a.
(Applicative f, Ord a, Num a) =>
a -> [f a] -> f a
evalTowards a
o (forall a b. (a -> b) -> [a] -> [b]
map Range a -> f a
go [Range a]
rs)