module Test.Speculate.Expr.Ground
( grounds
, groundBinds
, groundAndBinds
, equal
, lessOrEqual
, less
, inequal
, true
, false
, condEqual
, condEqualM
, trueBinds
, trueRatio
)
where
import Test.Speculate.Expr.Core
import Test.Speculate.Expr.Match
import Test.Speculate.Expr.Instance
import Test.Speculate.Expr.Equate
import Test.LeanCheck
import Data.Ratio
import Data.Functor ((<$>))
import Data.Maybe (fromMaybe)
grounds :: Instances -> Expr -> [Expr]
grounds ti e = (e `assigning`) <$> groundBinds ti e
groundBinds :: Instances -> Expr -> [Binds]
groundBinds ti e =
concat $ products [mapT ((,) n) (tiersE ti t) | (t,n) <- vars e]
groundAndBinds :: Instances -> Expr -> [(Binds,Expr)]
groundAndBinds ti e = (\bs -> (bs, e `assigning` bs)) <$> groundBinds ti e
equal :: Instances -> Int -> Expr -> Expr -> Bool
equal ti n e1 e2 = maybe False (true ti n) (equation ti e1 e2)
condEqual :: Instances -> Int -> Expr -> Expr -> Expr -> Bool
condEqual ti n pre e1 e2 = maybe False (true ti n) (conditionalEquation ti pre e1 e2)
condEqualM :: Instances -> Int -> Int -> Expr -> Expr -> Expr -> Bool
condEqualM ti n n0 pre e1 e2 = condEqual ti n pre e1 e2 && length cs >= n0
where
cs = fromMaybe []
$ filter (eval False) . map condition . take n . grounds ti
<$> conditionalEquation ti pre e1 e2
condition ceq = let (ce,_,_) = unConditionalEquation ceq in ce
lessOrEqual :: Instances -> Int -> Expr -> Expr -> Bool
lessOrEqual ti n e1 e2 = maybe False (true ti n) (comparisonLE ti e1 e2)
less :: Instances -> Int -> Expr -> Expr -> Bool
less ti n e1 e2 = maybe False (true ti n) (comparisonLT ti e1 e2)
inequal :: Instances -> Int -> Expr -> Expr -> Bool
inequal ti n e1 e2 = maybe False (false ti n) (equation ti e1 e2)
true :: Instances -> Int -> Expr -> Bool
true ti n e = all (eval False) . take n $ grounds ti e
trueBinds :: Instances -> Int -> Expr -> [Binds]
trueBinds ti n e = [bs | (bs,e) <- take n $ groundAndBinds ti e, eval False e]
trueRatio :: Instances -> Int -> Expr -> Ratio Int
trueRatio ti n e = length (trueBinds ti n e) % length (take n $ groundAndBinds ti e)
false :: Instances -> Int -> Expr -> Bool
false ti n e = all (not . eval False) . take n $ grounds ti e