{-# 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)

-- This show instance does not actually provide a way
-- to create an equation. Instead, it makes it look
-- like a lambda.
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