module Test.FitSpec.Engine
( property
, Property
, getResults
, getResultsExtra
, getResultsExtraTimeout
, Result (..)
, Results
, propertiesNTests
, propertiesTestsExhausted
, propertiesToMap
, propertiesHold
, propertiesCE
, minimal
, complete
, reduceImplications
, filterNonCanon
, Conjecture (..)
, conjectures
)
where
import Test.LeanCheck.Error
import Test.FitSpec.Utils
import Data.Maybe (catMaybes, listToMaybe)
import Data.List ((\\),union,transpose)
import Test.FitSpec.Mutable
type Property = [([String],Bool)]
type Properties = [Property]
property :: Testable a => a -> Property
property = results
propertyHolds :: Int -> Property -> Bool
propertyHolds n = all snd . take n
propertyCE :: Int -> Property -> Maybe String
propertyCE n = listToMaybe . map (unwords . fst) . filter (not . snd) . take n
propertiesToMap :: [Property] -> Int -> [Bool]
propertiesToMap ps n = map (propertyHolds n) ps
propertiesHold :: Int -> [Property] -> Bool
propertiesHold n = all (propertyHolds n)
propertiesCE :: Int -> [Property] -> Maybe String
propertiesCE n = listToMaybe
. catMaybes
. zipWith (\n -> fmap ((show n ++ ": ") ++)) [1..]
. map (propertyCE n)
propertiesNTests :: Int -> [Property] -> [Int]
propertiesNTests n = map (length . take n)
propertiesTestsExhausted :: Int -> [Property] -> [Bool]
propertiesTestsExhausted n = map (<= n) . propertiesNTests (n+1)
filterNonCanon :: [Result a] -> [Result a]
filterNonCanon [] = []
filterNonCanon (r:rs) = (r:)
. filterNonCanon
. filter (not . null . sets)
. map (updateSets removeNonCanon)
$ rs
where removeNonCanon = filter (not . (\p' -> (p' `contains`) `any` tail (sets r)))
updateSets f r = r { sets = f (sets r) }
reduceImplications :: [Result a] -> [Result a]
reduceImplications [] = []
reduceImplications (r:rs) = r : map (r `reduce`) (reduceImplications rs)
where r `reduce` r' = if or [s `contained` s' | s <- sets r, s' <- sets r']
then r' { implied = implied r' \\ implied r }
else r'
data Result a = Result
{ sets :: [[Int]]
, implied :: [Int]
, survivors :: [a]
, smallestSurvivor :: Maybe a
, nSurvivors :: Int
, nKilled :: Int
, totalMutants :: Int
, score :: Int
, maxTests :: Int
, mutantsExhausted :: Bool
}
type Results a = [Result a]
getResults :: (Mutable a)
=> a -> (a -> [Property]) -> Int -> Int
-> Results a
getResults = getResultsExtra []
getResultsExtra :: (Mutable a)
=> [a]
-> a -> (a -> [Property]) -> Int -> Int
-> Results a
getResultsExtra ems f ps nms nts = map (uncurry $ processRawResult mex nts)
$ getRawResults is pmap ms
where is = [1..(length $ ps f)]
pmap f = propertiesToMap (ps f) nts
ms' = take (nms+1) (tail $ mutants f)
mex = length ms' <= nms
ms = take nms ms' ++ ems
getResultsExtraTimeout :: (Mutable a)
=> Int
-> [a]
-> a -> (a -> [Property]) -> Int -> Int
-> IO (Results a)
getResultsExtraTimeout 0 ems f ps m n = return $ getResultsExtra ems f ps m n
getResultsExtraTimeout t ems f ps nm0 nt0 = lastTimeout t resultss
where
resultss = map fst
$ takeWhileIncreasingOn ((totalMutants . head) *** id)
[ (getResultsExtra ems f ps nm nt, propertiesNTests nt $ ps f)
| (nm,nt) <- iterate (incHalf *** incHalf) (nm0,nt0) ]
incHalf x = x + x `div` 2
processRawResult :: Bool -> Int -> [[Int]] -> [(a,Bool)] -> Result a
processRawResult mex nt iss mhs = Result
{ sets = relevantPropertySets iss
, implied = relevantImplications iss
, survivors = ms
, smallestSurvivor = listToMaybe ms
, nSurvivors = ns
, nKilled = nk
, totalMutants = nm
, score = nk*100 `div` nm
, maxTests = nt
, mutantsExhausted = mex
}
where ms = [m | (m,h) <- mhs, h]
nm = length mhs
ns = length ms
nk = nm ns
minimal :: Results a -> Bool
minimal (r:_) = null (implied r)
&& length (sets r) == 1
complete :: Results a -> Bool
complete (r:_) = nSurvivors r == 0
relevantPropertySets :: Eq i => [[i]] -> [[i]]
relevantPropertySets = filterU (not ... contained) . sortOn length
relevantImplications :: Eq i => [[i]] -> [i]
relevantImplications iss = foldr union [] iss
\\ foldr union [] (relevantPropertySets iss)
getRawResults :: [i] -> (a -> [Bool]) -> [a] -> [([[i]],[(a,Bool)])]
getRawResults is ps ms = (id *** (zip ms)) `map` getRawResults' is ps ms
getRawResults' :: [i] -> (a -> [Bool]) -> [a] -> [([[i]],[Bool])]
getRawResults' is pmap = sortOn (count id . snd)
. sortAndGroupFstBySnd
. zip (subsets is)
. transpose
. map (compositions . pmap)
nSurv :: (a -> [Bool]) -> [a] -> [Int]
nSurv props = map (count id)
. transpose
. map (compositions . props)
data Conjecture = Conjecture
{ isEq :: Bool
, isIm :: Bool
, cleft :: [Int]
, cright :: [Int]
, cscore :: Int
, cnKilled :: Int
, cnSurvivors :: Int
} deriving Show
conjectures :: [Result a] -> [Conjecture]
conjectures = concatMap conjectures1
. sortOn (abs . (50) . score)
. reduceImplications
. filterNonCanon
. reverse
conjectures1 :: Result a -> [Conjecture]
conjectures1 r = [ p `eq` p' | p' <- ps ]
++ [ p `im` i | (not.null) i ]
where
(p:ps) = sets r
i = implied r
eq = conj True
im = conj False
conj isE p p' = Conjecture
{ isEq = isE
, isIm = not isE
, cleft = p
, cright = p'
, cscore = score r
, cnKilled = nKilled r
, cnSurvivors = nSurvivors r
}