module Numeric.MixedTypes.Round
(
CanDivIMod(..), CanDivIModIntegerSameType, modNoCN, divINoCN, divIModNoCN
, CanRound(..), HasIntegerBounds(..)
, specCanDivIMod, specCanRound, specHasIntegerBounds
)
where
import Numeric.MixedTypes.PreludeHiding
import qualified Prelude as P
import Text.Printf
import Data.Fixed (divMod')
import Test.Hspec
import Test.QuickCheck as QC
import Numeric.CollectErrors
import Numeric.MixedTypes.Literals
import Numeric.MixedTypes.Bool
import Numeric.MixedTypes.Eq
import Numeric.MixedTypes.Ord
import Numeric.MixedTypes.AddSub
import Numeric.MixedTypes.Ring
class CanDivIMod t1 t2 where
type DivIType t1 t2
type DivIType t1 t2 = CN Integer
type ModType t1 t2
type ModType t1 t2 = EnsureCN t1
divIMod :: t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
mod :: t1 -> t2 -> ModType t1 t2
mod t1
a t2
b = (DivIType t1 t2, ModType t1 t2) -> ModType t1 t2
forall a b. (a, b) -> b
snd ((DivIType t1 t2, ModType t1 t2) -> ModType t1 t2)
-> (DivIType t1 t2, ModType t1 t2) -> ModType t1 t2
forall a b. (a -> b) -> a -> b
$ t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
forall t1 t2.
CanDivIMod t1 t2 =>
t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
divIMod t1
a t2
b
divI :: t1 -> t2 -> DivIType t1 t2
divI t1
a t2
b = (DivIType t1 t2, ModType t1 t2) -> DivIType t1 t2
forall a b. (a, b) -> a
fst ((DivIType t1 t2, ModType t1 t2) -> DivIType t1 t2)
-> (DivIType t1 t2, ModType t1 t2) -> DivIType t1 t2
forall a b. (a -> b) -> a -> b
$ t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
forall t1 t2.
CanDivIMod t1 t2 =>
t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
divIMod t1
a t2
b
type CanDivIModIntegerSameType t =
(CanDivIMod t t, CanEnsureCN t, DivIType t t ~ CN Integer, ModType t t ~ EnsureCN t)
modNoCN ::
(CanDivIMod t1 t2
, ModType t1 t2 ~ EnsureCN t1, CanEnsureCN t1)
=>
t1 -> t2 -> t1
modNoCN :: t1 -> t2 -> t1
modNoCN t1
x t2
m =
case EnsureCN t1 -> Either NumErrors t1
forall v. CanEnsureCN v => EnsureCN v -> Either NumErrors v
deEnsureCN (EnsureCN t1 -> Either NumErrors t1)
-> EnsureCN t1 -> Either NumErrors t1
forall a b. (a -> b) -> a -> b
$ t1
x t1 -> t2 -> ModType t1 t2
forall t1 t2. CanDivIMod t1 t2 => t1 -> t2 -> ModType t1 t2
`mod` t2
m of
Left NumErrors
err -> [Char] -> t1
forall a. HasCallStack => [Char] -> a
error ([Char] -> t1) -> [Char] -> t1
forall a b. (a -> b) -> a -> b
$ NumErrors -> [Char]
forall a. Show a => a -> [Char]
show NumErrors
err
Right t1
xm -> t1
xm
divINoCN ::
(CanDivIMod t1 t2, DivIType t1 t2 ~ CN Integer)
=>
t1 -> t2 -> Integer
divINoCN :: t1 -> t2 -> Integer
divINoCN t1
x t2
m = CN Integer -> EnsureNoCN (CN Integer)
forall v. (CanEnsureCN v, Show v) => v -> EnsureNoCN v
(~!) (CN Integer -> EnsureNoCN (CN Integer))
-> CN Integer -> EnsureNoCN (CN Integer)
forall a b. (a -> b) -> a -> b
$ t1
x t1 -> t2 -> DivIType t1 t2
forall t1 t2. CanDivIMod t1 t2 => t1 -> t2 -> DivIType t1 t2
`divI` t2
m
divIModNoCN ::
(CanDivIMod t1 t2
, ModType t1 t2 ~ EnsureCN t1, CanEnsureCN t1
, DivIType t1 t2 ~ CN Integer)
=>
t1 -> t2 -> (Integer, t1)
divIModNoCN :: t1 -> t2 -> (Integer, t1)
divIModNoCN t1
x t2
m =
case EnsureCN t1 -> Either NumErrors t1
forall v. CanEnsureCN v => EnsureCN v -> Either NumErrors v
deEnsureCN EnsureCN t1
xm of
Left NumErrors
err -> [Char] -> (Integer, t1)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Integer, t1)) -> [Char] -> (Integer, t1)
forall a b. (a -> b) -> a -> b
$ NumErrors -> [Char]
forall a. Show a => a -> [Char]
show NumErrors
err
Right t1
xm2 -> (CN Integer -> EnsureNoCN (CN Integer)
forall v. (CanEnsureCN v, Show v) => v -> EnsureNoCN v
(~!) CN Integer
d, t1
xm2)
where
(CN Integer
d,EnsureCN t1
xm) = t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
forall t1 t2.
CanDivIMod t1 t2 =>
t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
divIMod t1
x t2
m
instance CanDivIMod Integer Integer where
divIMod :: Integer
-> Integer -> (DivIType Integer Integer, ModType Integer Integer)
divIMod Integer
x Integer
m
| Integer
m Integer -> Integer -> OrderCompareType Integer Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Integer
0 = (Integer -> EnsureCN Integer
forall v. CanEnsureCN v => v -> EnsureCN v
cn Integer
d, Integer -> EnsureCN Integer
forall v. CanEnsureCN v => v -> EnsureCN v
cn Integer
xm)
| Bool
otherwise = (EnsureCN Integer
DivIType Integer Integer
err, EnsureCN Integer
ModType Integer Integer
err)
where
(Integer
d,Integer
xm) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
P.divMod Integer
x Integer
m
err :: EnsureCN Integer
err = Maybe Integer -> NumError -> EnsureCN Integer
forall v. CanEnsureCN v => Maybe v -> NumError -> EnsureCN v
noValueNumErrorCertainECN Maybe Integer
sample_v (NumError -> EnsureCN Integer) -> NumError -> EnsureCN Integer
forall a b. (a -> b) -> a -> b
$ [Char] -> NumError
OutOfRange ([Char] -> NumError) -> [Char] -> NumError
forall a b. (a -> b) -> a -> b
$ [Char]
"modulus not positive: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
m
sample_v :: Maybe Integer
sample_v = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
x
instance CanDivIMod Rational Rational where
divIMod :: Rational
-> Rational
-> (DivIType Rational Rational, ModType Rational Rational)
divIMod Rational
x Rational
m
| Rational
m Rational -> Integer -> OrderCompareType Rational Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Integer
0 = (Integer -> EnsureCN Integer
forall v. CanEnsureCN v => v -> EnsureCN v
cn Integer
d, Rational -> EnsureCN Rational
forall v. CanEnsureCN v => v -> EnsureCN v
cn Rational
xm)
| Bool
otherwise = (Integer -> EnsureCN Integer
forall v. CanEnsureCN v => v -> EnsureCN v
err (Integer
d :: Integer), Rational -> EnsureCN Rational
forall v. CanEnsureCN v => v -> EnsureCN v
err Rational
xm)
where
(Integer
d,Rational
xm) = Rational -> Rational -> (Integer, Rational)
forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod' Rational
x Rational
m
err :: (CanEnsureCN t) => t -> EnsureCN t
err :: t -> EnsureCN t
err t
s = Maybe t -> NumError -> EnsureCN t
forall v. CanEnsureCN v => Maybe v -> NumError -> EnsureCN v
noValueNumErrorCertainECN (t -> Maybe t
forall a. a -> Maybe a
Just t
s) (NumError -> EnsureCN t) -> NumError -> EnsureCN t
forall a b. (a -> b) -> a -> b
$ [Char] -> NumError
OutOfRange ([Char] -> NumError) -> [Char] -> NumError
forall a b. (a -> b) -> a -> b
$ [Char]
"modulus not positive: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Rational -> [Char]
forall a. Show a => a -> [Char]
show Rational
m
instance CanDivIMod Rational Integer where
divIMod :: Rational
-> Integer -> (DivIType Rational Integer, ModType Rational Integer)
divIMod Rational
x Integer
m = Rational
-> Rational
-> (DivIType Rational Rational, ModType Rational Rational)
forall t1 t2.
CanDivIMod t1 t2 =>
t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
divIMod Rational
x (Integer -> Rational
forall t. CanBeRational t => t -> Rational
rational Integer
m)
instance CanDivIMod Double Double where
divIMod :: Double -> Double -> (DivIType Double Double, ModType Double Double)
divIMod Double
x Double
m
| Double
m Double -> Integer -> OrderCompareType Double Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
> Integer
0 = (Integer -> EnsureCN Integer
forall v. CanEnsureCN v => v -> EnsureCN v
cn Integer
d, Double -> EnsureCN Double
forall v. CanEnsureCN v => v -> EnsureCN v
cn Double
xm)
| Bool
otherwise = (Integer -> EnsureCN Integer
forall v. CanEnsureCN v => v -> EnsureCN v
err (Integer
d :: Integer), Double -> EnsureCN Double
forall v. CanEnsureCN v => v -> EnsureCN v
err Double
xm)
where
(Integer
d,Double
xm) = Double -> Double -> (Integer, Double)
forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod' Double
x Double
m
err :: (CanEnsureCN t) => t -> EnsureCN t
err :: t -> EnsureCN t
err t
s = Maybe t -> NumError -> EnsureCN t
forall v. CanEnsureCN v => Maybe v -> NumError -> EnsureCN v
noValueNumErrorCertainECN (t -> Maybe t
forall a. a -> Maybe a
Just t
s) (NumError -> EnsureCN t) -> NumError -> EnsureCN t
forall a b. (a -> b) -> a -> b
$ [Char] -> NumError
OutOfRange ([Char] -> NumError) -> [Char] -> NumError
forall a b. (a -> b) -> a -> b
$ [Char]
"modulus not positive: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Double -> [Char]
forall a. Show a => a -> [Char]
show Double
m
instance CanDivIMod Double Integer where
divIMod :: Double
-> Integer -> (DivIType Double Integer, ModType Double Integer)
divIMod Double
x Integer
m = Double -> Double -> (DivIType Double Double, ModType Double Double)
forall t1 t2.
CanDivIMod t1 t2 =>
t1 -> t2 -> (DivIType t1 t2, ModType t1 t2)
divIMod Double
x (Integer -> Double
forall t. CanBeDouble t => t -> Double
double Integer
m)
type CanDivIModX t =
(CanDivIMod t t,
ModType t t ~ EnsureCN t,
DivIType t t ~ CN Integer,
EnsureNoCN t ~ t,
CanEnsureCN t,
CanMulBy t Integer,
CanAddSameType t,
HasOrderCertainly t Integer,
HasOrderCertainly t t,
HasEqCertainly t t,
CanTestFinite t,
Show t, Arbitrary t)
specCanDivIMod ::
(CanDivIModX t, HasIntegers t)
=>
T t -> Spec
specCanDivIMod :: T t -> Spec
specCanDivIMod (T [Char]
typeName :: T t) =
[Char] -> Spec -> Spec
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe ([Char] -> [Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"CanDivMod %s %s" [Char]
typeName [Char]
typeName) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
[Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"holds 0 <= x `mod` m < m" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> t -> Property) -> Property)
-> (t -> t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) (t
m :: t) ->
t -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t
x Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& t
m t -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Integer
0 Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
let xm :: t
xm = t
x t -> t -> t
forall t1 t2.
(CanDivIMod t1 t2, ModType t1 t2 ~ EnsureCN t1, CanEnsureCN t1) =>
t1 -> t2 -> t1
`modNoCN` t
m in
(Integer
0 Integer -> t -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ t
xm) Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (t
xm t -> t -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<?$ t
m)
[Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"holds x == (x `div'` m)*m + (x `mod` m)" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> t -> Property) -> Property)
-> (t -> t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) (t
m :: t) ->
t -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t
x Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& t
m t -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Integer
0 Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
let (Integer
d,t
xm) = t -> t -> (Integer, t)
forall t1 t2.
(CanDivIMod t1 t2, ModType t1 t2 ~ EnsureCN t1, CanEnsureCN t1,
DivIType t1 t2 ~ CN Integer) =>
t1 -> t2 -> (Integer, t1)
divIModNoCN t
x t
m in
(t
x t -> t -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (Integer
dInteger -> t -> MulType Integer t
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
*t
m t -> t -> AddType t t
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ t
xm))
where
(?<=?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
?<=?$ :: a -> b -> Property
(?<=?$) = [Char] -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
"?<=?" a -> b -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(?<=?)
(?<?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
?<?$ :: a -> b -> Property
(?<?$) = [Char] -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
"?<?" a -> b -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(?<?)
(?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
?==?$ :: a -> b -> Property
(?==?$) = [Char] -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
"?==?" a -> b -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(?==?)
class CanRound t where
properFraction :: t -> (Integer, t)
default properFraction :: (P.RealFrac t) => t -> (Integer, t)
properFraction = t -> (Integer, t)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
P.properFraction
truncate :: t -> Integer
truncate = (Integer, t) -> Integer
forall a b. (a, b) -> a
fst ((Integer, t) -> Integer) -> (t -> (Integer, t)) -> t -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> (Integer, t)
forall t. CanRound t => t -> (Integer, t)
properFraction
round :: t -> Integer
default round :: (HasOrderCertainly t Rational) => t -> Integer
round t
x
| -Rational
0.5 Rational -> t -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! t
r Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& t
r t -> Rational -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! Rational
0.5 = Integer
n
| t
r t -> Rational -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! -Rational
0.5 = Integer
n Integer -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
1
| t
r t -> Rational -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Rational
0.5 = Integer
n Integer -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
1
| Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
n = Integer
n
| t
r t -> Rational -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! Rational
0.0 = Integer
n Integer -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
1
| t
r t -> Rational -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!>! Rational
0.0 = Integer
n Integer -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
1
| Bool
otherwise = [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"round default defn: Bad value"
where
(Integer
n,t
r) = t -> (Integer, t)
forall t. CanRound t => t -> (Integer, t)
properFraction t
x
ceiling :: t -> Integer
default ceiling :: (CanTestPosNeg t) => t -> Integer
ceiling t
x
| t -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyPositive t
r = Integer
n Integer -> Integer -> AddType Integer Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
1
| Bool
otherwise = Integer
n
where
(Integer
n,t
r) = t -> (Integer, t)
forall t. CanRound t => t -> (Integer, t)
properFraction t
x
floor :: t -> Integer
default floor :: (CanTestPosNeg t) => t -> Integer
floor t
x
| t -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyNegative t
r = Integer
n Integer -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- Integer
1
| Bool
otherwise = Integer
n
where
(Integer
n,t
r) = t -> (Integer, t)
forall t. CanRound t => t -> (Integer, t)
properFraction t
x
instance CanRound Rational
instance CanRound Double where
round :: Double -> Integer
round = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.round
ceiling :: Double -> Integer
ceiling = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling
floor :: Double -> Integer
floor = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
P.floor
type CanRoundX t =
(CanRound t,
CanNegSameType t,
CanTestPosNeg t,
HasOrderCertainly t Integer,
CanTestFinite t,
Show t, Arbitrary t)
specCanRound ::
(CanRoundX t, HasIntegers t)
=>
T t -> Spec
specCanRound :: T t -> Spec
specCanRound (T [Char]
typeName :: T t) =
[Char] -> Spec -> Spec
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe ([Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"CanRound %s" [Char]
typeName) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
[Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"holds floor x <= x <= ceiling x" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
t -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t
x Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
(t -> Integer
forall t. CanRound t => t -> Integer
floor t
x Integer -> t -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ t
x) Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (t
x t -> Integer -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ t -> Integer
forall t. CanRound t => t -> Integer
ceiling t
x)
[Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"holds floor x <= round x <= ceiling x" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
t -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t
x Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
(t -> Integer
forall t. CanRound t => t -> Integer
floor t
x Integer -> Integer -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
!<=!$ t -> Integer
forall t. CanRound t => t -> Integer
round t
x) Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (t -> Integer
forall t. CanRound t => t -> Integer
round t
x Integer -> Integer -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
!<=!$ t -> Integer
forall t. CanRound t => t -> Integer
ceiling t
x)
[Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"0 <= ceiling x - floor x <= 1" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
t -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t
x Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
(t -> Integer
forall t. CanRound t => t -> Integer
ceiling t
x Integer -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- t -> Integer
forall t. CanRound t => t -> Integer
floor t
x) Integer -> [Integer] -> Property
`elem_PF` [Integer
0,Integer
1]
[Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"holds floor x = round x = ceiling x for integers" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(Integer -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((Integer -> Property) -> Property)
-> (Integer -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (Integer
xi :: Integer) ->
let x :: t
x = Integer -> t
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
xi :: t in
(t -> Integer
forall t. CanRound t => t -> Integer
floor t
x Integer -> Integer -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
!==!$ t -> Integer
forall t. CanRound t => t -> Integer
round t
x) Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (t -> Integer
forall t. CanRound t => t -> Integer
round t
x Integer -> Integer -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
!==!$ t -> Integer
forall t. CanRound t => t -> Integer
ceiling t
x)
where
(?<=?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
?<=?$ :: a -> b -> Property
(?<=?$) = [Char] -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
"?<=?" a -> b -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(?<=?)
(!<=!$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
!<=!$ :: a -> b -> Property
(!<=!$) = [Char] -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
"!<=!" a -> b -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(!<=!)
(!==!$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
!==!$ :: a -> b -> Property
(!==!$) = [Char] -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
"!==!" a -> b -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(!==!)
elem_PF :: Integer -> [Integer] -> Property
elem_PF = [Char]
-> (Integer -> [Integer] -> Bool)
-> Integer
-> [Integer]
-> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
"elem" Integer -> [Integer] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem
class HasIntegerBounds t where
integerBounds :: t -> (Integer, Integer)
default integerBounds :: (CanRound t) => t -> (Integer, Integer)
integerBounds t
x = (t -> Integer
forall t. CanRound t => t -> Integer
floor t
x, t -> Integer
forall t. CanRound t => t -> Integer
ceiling t
x)
instance HasIntegerBounds Rational
instance HasIntegerBounds Double
instance HasIntegerBounds Integer where
integerBounds :: Integer -> (Integer, Integer)
integerBounds Integer
n = (Integer
n,Integer
n)
instance HasIntegerBounds Int where
integerBounds :: Int -> (Integer, Integer)
integerBounds Int
n = (Integer
n',Integer
n') where n' :: Integer
n' = Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
n
type HasIntegerBoundsX t =
(HasIntegerBounds t,
HasOrderCertainly t Integer,
CanTestFinite t,
Show t, Arbitrary t)
specHasIntegerBounds ::
(HasIntegerBoundsX t)
=>
T t -> Spec
specHasIntegerBounds :: T t -> Spec
specHasIntegerBounds (T [Char]
typeName :: T t) =
[Char] -> Spec -> Spec
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe ([Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"HasIntegerBounds %s" [Char]
typeName) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
[Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"holds l <= x <= r" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
t -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t
x Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
let (Integer
l,Integer
r) = t -> (Integer, Integer)
forall t. HasIntegerBounds t => t -> (Integer, Integer)
integerBounds t
x in
(Integer
l Integer -> t -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ t
x) Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (t
x t -> Integer -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ Integer
r)
where
(?<=?$) :: (HasOrderCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
?<=?$ :: a -> b -> Property
(?<=?$) = [Char] -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
"?<=?" a -> b -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(?<=?)