module Test.Speculate.Expr.Ground
( grounds
, groundBinds
, equal
, lessOrEqual
, less
, inequal
, isTrue
, isFalse
, condEqual
, condEqualM
, trueRatio
)
where
import Test.Speculate.Expr.Core
import Test.Speculate.Expr.Instance
import Test.Speculate.Expr.Equate
import Test.LeanCheck
import Test.LeanCheck.Error (errorToFalse)
import Data.Ratio
import Data.Functor ((<$>))
grounds :: (Expr -> [[Expr]]) -> Expr -> [Expr]
grounds tiersFor e = (e //-) <$> groundBinds tiersFor e
groundBinds :: (Expr -> [[Expr]]) -> Expr -> [Binds]
groundBinds tiersFor e =
concat $ products [mapT ((,) v) (tiersFor v) | v <- nubVars e]
equal :: Instances -> Int -> Expr -> Expr -> Bool
equal ti n = isTrueComparison (take n . grounds (lookupTiers ti)) (mkEquation ti)
condEqual :: Instances -> Int -> Expr -> Expr -> Expr -> Bool
condEqual ti n pre e1 e2 = isTrue (take n . grounds (lookupTiers ti)) (mkConditionalEquation 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 = filter evalBool . map condition . take n . grounds (lookupTiers ti)
$ mkConditionalEquation ti pre e1 e2
condition ceq = let (ce,_,_) = unConditionalEquation ceq in ce
lessOrEqual :: Instances -> Int -> Expr -> Expr -> Bool
lessOrEqual ti n = isTrueComparison (take n . grounds (lookupTiers ti)) (mkComparisonLE ti)
less :: Instances -> Int -> Expr -> Expr -> Bool
less ti n = isTrueComparison (take n . grounds (lookupTiers ti)) (mkComparisonLT ti)
inequal :: Instances -> Int -> Expr -> Expr -> Bool
inequal ti n e1 e2 = isFalse (take n . grounds (lookupTiers ti)) (mkEquation ti e1 e2)
trueRatio :: Instances -> Int -> Expr -> Ratio Int
trueRatio is n e = length trueBinds % length gs
where
gs = take n $ grounds (lookupTiers is) e
trueBinds = [e | e <- gs , eval False e]
isTrueComparison :: (Expr -> [Expr]) -> (Expr -> Expr -> Expr) -> Expr -> Expr -> Bool
isTrueComparison grounds mkComparison e1 e2 = isTrue grounds (mkComparison e1 e2)
isTrue :: (Expr -> [Expr]) -> Expr -> Bool
isTrue grounds = all evalBool . grounds
isFalse :: (Expr -> [Expr]) -> Expr -> Bool
isFalse grounds = all (not . evalBool) . grounds
evalBool :: Expr -> Bool
evalBool = errorToFalse . eval False