module Test.Falsify.Range (
Range
, between
, enum
, withOrigin
, skewedBy
, origin
, ProperFraction(..)
, Precision(..)
, constant
, fromProperFraction
, towards
, eval
) where
import Data.Bits
import Data.List.NonEmpty (NonEmpty(..))
import Data.Ord
import qualified Data.List.NonEmpty as NE
import Test.Falsify.Internal.Range
import Data.Functor.Identity
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 :: forall a. (Ord a, Num a) => a -> [Range a] -> Range a
towards :: forall a. (Ord a, Num a) => a -> [Range a] -> Range a
towards a
o [] = forall a. a -> Range a
Constant a
o
towards a
o (Range a
r:[Range a]
rs) = forall b a. Ord b => NonEmpty (Range (a, b)) -> Range a
Smallest forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range a -> Range (a, a)
aux (Range a
r forall a. a -> [a] -> NonEmpty a
:| [Range a]
rs)
where
aux :: Range a -> Range (a, a)
aux :: Range a -> Range (a, a)
aux = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ \a
x -> (a
x, a -> a
distanceToOrigin a
x)
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
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
enum :: Enum a => (a, a) -> Range a
enum :: forall a. Enum a => (a, a) -> Range a
enum (a
x, a
y) = forall a. Enum a => Int -> a
toEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Integral a, FiniteBits a) => (a, a) -> Range a
between (forall a. Enum a => a -> Int
fromEnum a
x, forall a. Enum a => a -> Int
fromEnum a
y)
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. (Ord a, Num 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 = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
Applicative f =>
(Precision -> f ProperFraction) -> Range a -> f a
eval (\Precision
_precision -> forall a. a -> Identity a
Identity forall a b. (a -> b) -> a -> b
$ Double -> ProperFraction
ProperFraction Double
0)
eval :: forall f a.
Applicative f
=> (Precision -> f ProperFraction) -> Range a -> f a
eval :: forall (f :: * -> *) a.
Applicative f =>
(Precision -> f ProperFraction) -> Range a -> f a
eval Precision -> f ProperFraction
genFraction = forall x. Range x -> f x
go
where
go :: forall x. Range x -> f x
go :: forall x. Range x -> f x
go Range x
r =
case Range x
r of
Constant x
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x
FromProperFraction Precision
p ProperFraction -> x
f -> ProperFraction -> x
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Precision -> f ProperFraction
genFraction Precision
p
Smallest NonEmpty (Range (x, b))
rs -> forall b x. Ord b => NonEmpty (x, b) -> x
smallest 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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall x. Range x -> f x
go NonEmpty (Range (x, b))
rs)
smallest :: Ord b => NonEmpty (x, b) -> x
smallest :: forall b x. Ord b => NonEmpty (x, b) -> x
smallest = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NE.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NE.sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> b
snd)