{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Hedgehog.Classes.Common.Equation
( LinearEquation(..), runLinearEquation, genLinearEquation
, LinearEquationTwo(..), runLinearEquationTwo, genLinearEquationTwo
, LinearEquationM(..), runLinearEquationM, genLinearEquationM
, QuadraticEquation(..), runQuadraticEquation, genQuadraticEquation
, CubicEquation(..), runCubicEquation, genCubicEquation
#ifdef HAVE_COMONAD
, LinearEquationW(..), runLinearEquationW, genLinearEquationW
#endif
) where
import Hedgehog
import Hedgehog.Classes.Common.Gen
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import qualified Data.List as List
import Data.Monoid (Endo(..))
#ifdef HAVE_COMONAD
import Control.Comonad
#endif
data QuadraticEquation = QuadraticEquation
{ QuadraticEquation -> Integer
_quadraticEquationQuadratic :: Integer
, QuadraticEquation -> Integer
_quadraticEquationLinear :: Integer
, QuadraticEquation -> Integer
_quadraticEquationConstant :: Integer
}
deriving (QuadraticEquation -> QuadraticEquation -> Bool
(QuadraticEquation -> QuadraticEquation -> Bool)
-> (QuadraticEquation -> QuadraticEquation -> Bool)
-> Eq QuadraticEquation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuadraticEquation -> QuadraticEquation -> Bool
$c/= :: QuadraticEquation -> QuadraticEquation -> Bool
== :: QuadraticEquation -> QuadraticEquation -> Bool
$c== :: QuadraticEquation -> QuadraticEquation -> Bool
Eq)
instance Show QuadraticEquation where
show :: QuadraticEquation -> String
show (QuadraticEquation Integer
a Integer
b Integer
c) = String
"\\x -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" * x ^ 2 + " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" * x + " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
c
genQuadraticEquation :: Gen QuadraticEquation
genQuadraticEquation :: Gen QuadraticEquation
genQuadraticEquation = do
Integer
a <- Range Integer -> GenT Identity Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Integer -> Integer -> Range Integer
forall a. Integral a => a -> a -> Range a
Range.linear Integer
0 Integer
15)
Integer
b <- Range Integer -> GenT Identity Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Integer -> Integer -> Range Integer
forall a. Integral a => a -> a -> Range a
Range.linear Integer
0 Integer
15)
Integer
c <- Range Integer -> GenT Identity Integer
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Integer -> Integer -> Range Integer
forall a. Integral a => a -> a -> Range a
Range.linear Integer
0 Integer
15)
QuadraticEquation -> Gen QuadraticEquation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Integer -> Integer -> QuadraticEquation
QuadraticEquation Integer
a Integer
b Integer
c)
runQuadraticEquation :: QuadraticEquation -> Integer -> Integer
runQuadraticEquation :: QuadraticEquation -> Integer -> Integer
runQuadraticEquation (QuadraticEquation Integer
a Integer
b Integer
c) Integer
x = Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
2 :: Integer) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
c
data LinearEquation = LinearEquation
{ LinearEquation -> Integer
_linearEquationLinear :: Integer
, LinearEquation -> Integer
_linearEquationConstant :: Integer
}
deriving (LinearEquation -> LinearEquation -> Bool
(LinearEquation -> LinearEquation -> Bool)
-> (LinearEquation -> LinearEquation -> Bool) -> Eq LinearEquation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinearEquation -> LinearEquation -> Bool
$c/= :: LinearEquation -> LinearEquation -> Bool
== :: LinearEquation -> LinearEquation -> Bool
$c== :: LinearEquation -> LinearEquation -> Bool
Eq)
instance Show LinearEquation where
showsPrec :: Int -> LinearEquation -> ShowS
showsPrec Int
_ (LinearEquation Integer
a Integer
b) = Integer -> ShowS
forall a. Show a => a -> ShowS
shows Integer
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" * x + " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ShowS
forall a. Show a => a -> ShowS
shows Integer
b
showList :: [LinearEquation] -> ShowS
showList [LinearEquation]
xs = Endo String -> ShowS
forall a. Endo a -> a -> a
appEndo
(Endo String -> ShowS) -> Endo String -> ShowS
forall a b. (a -> b) -> a -> b
$ [Endo String] -> Endo String
forall a. Monoid a => [a] -> a
mconcat
([Endo String] -> Endo String) -> [Endo String] -> Endo String
forall a b. (a -> b) -> a -> b
$ [ShowS -> Endo String
forall a. (a -> a) -> Endo a
Endo (Char -> ShowS
showChar Char
'[')]
[Endo String] -> [Endo String] -> [Endo String]
forall a. [a] -> [a] -> [a]
++ Endo String -> [Endo String] -> [Endo String]
forall a. a -> [a] -> [a]
List.intersperse (ShowS -> Endo String
forall a. (a -> a) -> Endo a
Endo (Char -> ShowS
showChar Char
',')) ((LinearEquation -> Endo String)
-> [LinearEquation] -> [Endo String]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS -> Endo String
forall a. (a -> a) -> Endo a
Endo (ShowS -> Endo String)
-> (LinearEquation -> ShowS) -> LinearEquation -> Endo String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> LinearEquation -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0) [LinearEquation]
xs)
[Endo String] -> [Endo String] -> [Endo String]
forall a. [a] -> [a] -> [a]
++ [ShowS -> Endo String
forall a. (a -> a) -> Endo a
Endo (Char -> ShowS
showChar Char
']')]
runLinearEquation :: LinearEquation -> Integer -> Integer
runLinearEquation :: LinearEquation -> Integer -> Integer
runLinearEquation (LinearEquation Integer
a Integer
b) Integer
x = Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b
genLinearEquation :: Gen LinearEquation
genLinearEquation :: Gen LinearEquation
genLinearEquation = Integer -> Integer -> LinearEquation
LinearEquation (Integer -> Integer -> LinearEquation)
-> GenT Identity Integer
-> GenT Identity (Integer -> LinearEquation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Integer
genSmallInteger GenT Identity (Integer -> LinearEquation)
-> GenT Identity Integer -> Gen LinearEquation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Integer
genSmallInteger
#ifdef HAVE_COMONAD
data LinearEquationW w = LinearEquationW (w LinearEquation) (w LinearEquation)
deriving instance (forall x. Eq x => Eq (w x)) => Eq (LinearEquationW w)
instance (forall x. Show x => Show (w x)) => Show (LinearEquationW w) where
show :: LinearEquationW w -> String
show (LinearEquationW w LinearEquation
a w LinearEquation
b) = (\ShowS
f -> ShowS
f String
"")
(ShowS -> String) -> ShowS -> String
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"\\x -> if odd x then "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> w LinearEquation -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 w LinearEquation
a
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" else "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> w LinearEquation -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 w LinearEquation
b
runLinearEquationW :: Comonad w
=> LinearEquationW w -> w Integer -> Integer
runLinearEquationW :: LinearEquationW w -> w Integer -> Integer
runLinearEquationW (LinearEquationW w LinearEquation
e1 w LinearEquation
e2) (w Integer -> Integer
forall (w :: * -> *) a. Comonad w => w a -> a
extract -> Integer
i) = if Integer -> Bool
forall a. Integral a => a -> Bool
odd Integer
i
then LinearEquation -> Integer -> Integer
runLinearEquation (w LinearEquation -> LinearEquation
forall (w :: * -> *) a. Comonad w => w a -> a
extract w LinearEquation
e1) Integer
i
else LinearEquation -> Integer -> Integer
runLinearEquation (w LinearEquation -> LinearEquation
forall (w :: * -> *) a. Comonad w => w a -> a
extract w LinearEquation
e2) Integer
i
genLinearEquationW :: Comonad w
=> (forall x. Gen x -> Gen (w x))
-> Gen (LinearEquationW w)
genLinearEquationW :: (forall x. Gen x -> Gen (w x)) -> Gen (LinearEquationW w)
genLinearEquationW forall x. Gen x -> Gen (w x)
fgen = w LinearEquation -> w LinearEquation -> LinearEquationW w
forall (w :: * -> *).
w LinearEquation -> w LinearEquation -> LinearEquationW w
LinearEquationW
(w LinearEquation -> w LinearEquation -> LinearEquationW w)
-> GenT Identity (w LinearEquation)
-> GenT Identity (w LinearEquation -> LinearEquationW w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen LinearEquation -> GenT Identity (w LinearEquation)
forall x. Gen x -> Gen (w x)
fgen Gen LinearEquation
genLinearEquation
GenT Identity (w LinearEquation -> LinearEquationW w)
-> GenT Identity (w LinearEquation) -> Gen (LinearEquationW w)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen LinearEquation -> GenT Identity (w LinearEquation)
forall x. Gen x -> Gen (w x)
fgen Gen LinearEquation
genLinearEquation
#endif
data LinearEquationM m = LinearEquationM (m LinearEquation) (m LinearEquation)
deriving instance (forall x. Eq x => Eq (m x)) => Eq (LinearEquationM m)
instance (forall x. Show x => Show (m x)) => Show (LinearEquationM m) where
show :: LinearEquationM m -> String
show (LinearEquationM m LinearEquation
a m LinearEquation
b) = (\ShowS
f -> ShowS
f String
"")
(ShowS -> String) -> ShowS -> String
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"\\x -> if odd x then "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m LinearEquation -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 m LinearEquation
a
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" else "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m LinearEquation -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 m LinearEquation
b
runLinearEquationM :: Functor m => LinearEquationM m -> Integer -> m Integer
runLinearEquationM :: LinearEquationM m -> Integer -> m Integer
runLinearEquationM (LinearEquationM m LinearEquation
e1 m LinearEquation
e2) Integer
i = if Integer -> Bool
forall a. Integral a => a -> Bool
odd Integer
i
then (LinearEquation -> Integer) -> m LinearEquation -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LinearEquation -> Integer -> Integer)
-> Integer -> LinearEquation -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip LinearEquation -> Integer -> Integer
runLinearEquation Integer
i) m LinearEquation
e1
else (LinearEquation -> Integer) -> m LinearEquation -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LinearEquation -> Integer -> Integer)
-> Integer -> LinearEquation -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip LinearEquation -> Integer -> Integer
runLinearEquation Integer
i) m LinearEquation
e2
genLinearEquationM :: Applicative m => Gen (LinearEquationM m)
genLinearEquationM :: Gen (LinearEquationM m)
genLinearEquationM = m LinearEquation -> m LinearEquation -> LinearEquationM m
forall (m :: * -> *).
m LinearEquation -> m LinearEquation -> LinearEquationM m
LinearEquationM (m LinearEquation -> m LinearEquation -> LinearEquationM m)
-> GenT Identity (m LinearEquation)
-> GenT Identity (m LinearEquation -> LinearEquationM m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LinearEquation -> m LinearEquation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LinearEquation -> m LinearEquation)
-> Gen LinearEquation -> GenT Identity (m LinearEquation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen LinearEquation
genLinearEquation) GenT Identity (m LinearEquation -> LinearEquationM m)
-> GenT Identity (m LinearEquation) -> Gen (LinearEquationM m)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (LinearEquation -> m LinearEquation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LinearEquation -> m LinearEquation)
-> Gen LinearEquation -> GenT Identity (m LinearEquation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen LinearEquation
genLinearEquation)
data LinearEquationTwo = LinearEquationTwo
{ LinearEquationTwo -> Integer
_linearEquationTwoX :: Integer
, LinearEquationTwo -> Integer
_linearEquationTwoY :: Integer
, LinearEquationTwo -> Integer
_linearEquationTwoConstant :: Integer
}
instance Show LinearEquationTwo where
show :: LinearEquationTwo -> String
show (LinearEquationTwo Integer
x Integer
y Integer
c) = String
"\\x y -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" * x + " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" * y + " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
c
genLinearEquationTwo :: Gen LinearEquationTwo
genLinearEquationTwo :: Gen LinearEquationTwo
genLinearEquationTwo = Integer -> Integer -> Integer -> LinearEquationTwo
LinearEquationTwo (Integer -> Integer -> Integer -> LinearEquationTwo)
-> GenT Identity Integer
-> GenT Identity (Integer -> Integer -> LinearEquationTwo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Integer
absGenInteger GenT Identity (Integer -> Integer -> LinearEquationTwo)
-> GenT Identity Integer
-> GenT Identity (Integer -> LinearEquationTwo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Integer
absGenInteger GenT Identity (Integer -> LinearEquationTwo)
-> GenT Identity Integer -> Gen LinearEquationTwo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Integer
absGenInteger
where
absGenInteger :: GenT Identity Integer
absGenInteger = Integer -> Integer
forall a. Num a => a -> a
abs (Integer -> Integer)
-> GenT Identity Integer -> GenT Identity Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Integer
genSmallInteger
runLinearEquationTwo :: LinearEquationTwo -> Integer -> Integer -> Integer
runLinearEquationTwo :: LinearEquationTwo -> Integer -> Integer -> Integer
runLinearEquationTwo (LinearEquationTwo Integer
a Integer
b Integer
c) Integer
x Integer
y = Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
c
data CubicEquation = CubicEquation
{ CubicEquation -> Integer
_cubicEquationCubic :: Integer
, CubicEquation -> Integer
_cubicEquationQuadratic :: Integer
, CubicEquation -> Integer
_cubicEquationLinear :: Integer
, CubicEquation -> Integer
_cubicEquationConstant :: Integer
}
instance Show CubicEquation where
show :: CubicEquation -> String
show (CubicEquation Integer
x Integer
y Integer
z Integer
c) = String
"\\x -> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" * x ^ 3 + " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" * x ^ 2 + " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
z String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" * x + " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
c
genCubicEquation :: Gen CubicEquation
genCubicEquation :: Gen CubicEquation
genCubicEquation = Integer -> Integer -> Integer -> Integer -> CubicEquation
CubicEquation (Integer -> Integer -> Integer -> Integer -> CubicEquation)
-> GenT Identity Integer
-> GenT Identity (Integer -> Integer -> Integer -> CubicEquation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity Integer
genSmallInteger GenT Identity (Integer -> Integer -> Integer -> CubicEquation)
-> GenT Identity Integer
-> GenT Identity (Integer -> Integer -> CubicEquation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Integer
genSmallInteger GenT Identity (Integer -> Integer -> CubicEquation)
-> GenT Identity Integer
-> GenT Identity (Integer -> CubicEquation)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Integer
genSmallInteger GenT Identity (Integer -> CubicEquation)
-> GenT Identity Integer -> Gen CubicEquation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Integer
genSmallInteger
runCubicEquation :: CubicEquation -> Integer -> Integer -> Integer -> Integer
runCubicEquation :: CubicEquation -> Integer -> Integer -> Integer -> Integer
runCubicEquation (CubicEquation Integer
a Integer
b Integer
c Integer
d) Integer
x Integer
y Integer
z = Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
c Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
z Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
d