-- |
-- Module      : Test.FitSpec.Engine
-- Copyright   : (c) 2015-2017 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- FitSpec: refining property-sets for functional testing
--
-- This is the main engine, besides "Test.FitSpec.Mutable".
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

-- | An encoded representation of a property suitable for use by FitSpec.
--
-- Each list of strings is a printable representation of one possible choice of
-- argument values for the property.  Each boolean indicate whether the
-- property holds for this choice.
type Property = [([String],Bool)]
type Properties = [Property]

-- | Given a 'Testable' type (as defined by "Test.LeanCheck"), returns a 'Property'.
--
-- This function should be used on every property to create a property list to
-- be passed to 'report', 'reportWith', 'mainDefault' or 'mainWith'.
--
-- > property $ \x y -> x + y < y + (x::Int)
property :: Testable a => a -> Property
property :: a -> Property
property = a -> Property
forall a. Testable a => a -> Property
results

propertyHolds :: Int -> Property -> Bool
propertyHolds :: Int -> Property -> Bool
propertyHolds Int
n = (([String], Bool) -> Bool) -> Property -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([String], Bool) -> Bool
forall a b. (a, b) -> b
snd (Property -> Bool) -> (Property -> Property) -> Property -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Property -> Property
forall a. Int -> [a] -> [a]
take Int
n

propertyCE :: Int -> Property -> Maybe String
propertyCE :: Int -> Property -> Maybe String
propertyCE Int
n = [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe ([String] -> Maybe String)
-> (Property -> [String]) -> Property -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], Bool) -> String) -> Property -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> String
unwords ([String] -> String)
-> (([String], Bool) -> [String]) -> ([String], Bool) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], Bool) -> [String]
forall a b. (a, b) -> a
fst) (Property -> [String])
-> (Property -> Property) -> Property -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], Bool) -> Bool) -> Property -> Property
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (([String], Bool) -> Bool) -> ([String], Bool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], Bool) -> Bool
forall a b. (a, b) -> b
snd) (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Property -> Property
forall a. Int -> [a] -> [a]
take Int
n

propertiesToMap :: [Property] -> Int -> [Bool]
propertiesToMap :: [Property] -> Int -> [Bool]
propertiesToMap [Property]
ps Int
n = (Property -> Bool) -> [Property] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Property -> Bool
propertyHolds Int
n) [Property]
ps

propertiesHold :: Int -> [Property] -> Bool
propertiesHold :: Int -> [Property] -> Bool
propertiesHold Int
n = (Property -> Bool) -> [Property] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Property -> Bool
propertyHolds Int
n)

propertiesCE :: Int -> [Property] -> Maybe String
propertiesCE :: Int -> [Property] -> Maybe String
propertiesCE Int
n = [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe
               ([String] -> Maybe String)
-> ([Property] -> [String]) -> [Property] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes
               ([Maybe String] -> [String])
-> ([Property] -> [Maybe String]) -> [Property] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Maybe String -> Maybe String)
-> [Integer] -> [Maybe String] -> [Maybe String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Integer
n -> (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Integer -> String
forall a. Show a => a -> String
show Integer
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":  ") String -> String -> String
forall a. [a] -> [a] -> [a]
++)) [Integer
1..]
               ([Maybe String] -> [Maybe String])
-> ([Property] -> [Maybe String]) -> [Property] -> [Maybe String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Property -> Maybe String) -> [Property] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Property -> Maybe String
propertyCE Int
n)

propertiesNTests :: Int -> [Property] -> [Int]
propertiesNTests :: Int -> [Property] -> [Int]
propertiesNTests Int
n = (Property -> Int) -> [Property] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Property -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Property -> Int) -> (Property -> Property) -> Property -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Property -> Property
forall a. Int -> [a] -> [a]
take Int
n)

propertiesTestsExhausted :: Int -> [Property] -> [Bool]
propertiesTestsExhausted :: Int -> [Property] -> [Bool]
propertiesTestsExhausted Int
n = (Int -> Bool) -> [Int] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n) ([Int] -> [Bool]) -> ([Property] -> [Int]) -> [Property] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Property] -> [Int]
propertiesNTests (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

filterNonCanon :: [Result a] -> [Result a]
filterNonCanon :: [Result a] -> [Result a]
filterNonCanon [] = []
filterNonCanon (Result a
r:[Result a]
rs) = (Result a
rResult a -> [Result a] -> [Result a]
forall a. a -> [a] -> [a]
:)
                      ([Result a] -> [Result a])
-> ([Result a] -> [Result a]) -> [Result a] -> [Result a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Result a] -> [Result a]
forall a. [Result a] -> [Result a]
filterNonCanon
                      ([Result a] -> [Result a])
-> ([Result a] -> [Result a]) -> [Result a] -> [Result a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result a -> Bool) -> [Result a] -> [Result a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Result a -> Bool) -> Result a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Int]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[Int]] -> Bool) -> (Result a -> [[Int]]) -> Result a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result a -> [[Int]]
forall a. Result a -> [[Int]]
sets)
                      ([Result a] -> [Result a])
-> ([Result a] -> [Result a]) -> [Result a] -> [Result a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result a -> Result a) -> [Result a] -> [Result a]
forall a b. (a -> b) -> [a] -> [b]
map (([[Int]] -> [[Int]]) -> Result a -> Result a
forall a. ([[Int]] -> [[Int]]) -> Result a -> Result a
updateSets [[Int]] -> [[Int]]
removeNonCanon)
                      ([Result a] -> [Result a]) -> [Result a] -> [Result a]
forall a b. (a -> b) -> a -> b
$ [Result a]
rs
  where removeNonCanon :: [[Int]] -> [[Int]]
removeNonCanon = ([Int] -> Bool) -> [[Int]] -> [[Int]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Int] -> Bool) -> [Int] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[Int]
p' -> ([Int]
p' [Int] -> [Int] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`contains`) ([Int] -> Bool) -> [[Int]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`any` [[Int]] -> [[Int]]
forall a. [a] -> [a]
tail (Result a -> [[Int]]
forall a. Result a -> [[Int]]
sets Result a
r)))
        updateSets :: ([[Int]] -> [[Int]]) -> Result a -> Result a
updateSets [[Int]] -> [[Int]]
f Result a
r = Result a
r { sets :: [[Int]]
sets = [[Int]] -> [[Int]]
f (Result a -> [[Int]]
forall a. Result a -> [[Int]]
sets Result a
r) }

reduceImplications :: [Result a] -> [Result a]
reduceImplications :: [Result a] -> [Result a]
reduceImplications [] = []
reduceImplications (Result a
r:[Result a]
rs) = Result a
r Result a -> [Result a] -> [Result a]
forall a. a -> [a] -> [a]
: (Result a -> Result a) -> [Result a] -> [Result a]
forall a b. (a -> b) -> [a] -> [b]
map (Result a
r Result a -> Result a -> Result a
forall a a. Result a -> Result a -> Result a
`reduce`) ([Result a] -> [Result a]
forall a. [Result a] -> [Result a]
reduceImplications [Result a]
rs)
  where Result a
r reduce :: Result a -> Result a -> Result a
`reduce` Result a
r' = if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [[Int]
s [Int] -> [Int] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`contained` [Int]
s' | [Int]
s <- Result a -> [[Int]]
forall a. Result a -> [[Int]]
sets Result a
r, [Int]
s' <- Result a -> [[Int]]
forall a. Result a -> [[Int]]
sets Result a
r']
                          then Result a
r' { implied :: [Int]
implied = Result a -> [Int]
forall a. Result a -> [Int]
implied Result a
r' [Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
\\ Result a -> [Int]
forall a. Result a -> [Int]
implied Result a
r }
                          else Result a
r'


-- | A line of result for a single equivalence class of properties
--   with the exact same surviving mutants.
data Result a = Result
  { Result a -> [[Int]]
sets             :: [[Int]] -- ^ property-sets in the equivalence class
  , Result a -> [Int]
implied          :: [Int]   -- ^ properties implied by this class
  , Result a -> [a]
survivors        :: [a]     -- ^ list of surviving mutants
  , Result a -> Maybe a
smallestSurvivor :: Maybe a -- ^ smallest surviving mutant, if any
  , Result a -> Int
nSurvivors       :: Int -- ^ number of surviving mutants
  , Result a -> Int
nKilled          :: Int -- ^ number of killed mutants
  , Result a -> Int
totalMutants     :: Int -- ^ total number of mutants generated and tested
  , Result a -> Int
score            :: Int -- ^ percentage of killed mutants, 0-100
  , Result a -> Int
maxTests         :: Int -- ^ Requested number of tests (same for all rs.)
  , Result a -> Bool
mutantsExhausted :: Bool -- ^ mutants were exhausted
  }
type Results a = [Result a]


-- | Return minimality and completeness results.  See 'report'.
getResults :: (Mutable a)
           => a -> (a -> [Property]) -> Int -> Int
           -> Results a
getResults :: a -> (a -> [Property]) -> Int -> Int -> Results a
getResults = [a] -> a -> (a -> [Property]) -> Int -> Int -> Results a
forall a.
Mutable a =>
[a] -> a -> (a -> [Property]) -> Int -> Int -> Results a
getResultsExtra []

getResultsExtra :: (Mutable a)
                => [a]
                -> a -> (a -> [Property]) -> Int -> Int
                -> Results a
getResultsExtra :: [a] -> a -> (a -> [Property]) -> Int -> Int -> Results a
getResultsExtra [a]
ems a
f a -> [Property]
ps Int
nms Int
nts = (([[Int]], [(a, Bool)]) -> Result a)
-> [([[Int]], [(a, Bool)])] -> Results a
forall a b. (a -> b) -> [a] -> [b]
map (([[Int]] -> [(a, Bool)] -> Result a)
-> ([[Int]], [(a, Bool)]) -> Result a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (([[Int]] -> [(a, Bool)] -> Result a)
 -> ([[Int]], [(a, Bool)]) -> Result a)
-> ([[Int]] -> [(a, Bool)] -> Result a)
-> ([[Int]], [(a, Bool)])
-> Result a
forall a b. (a -> b) -> a -> b
$ Bool -> Int -> [[Int]] -> [(a, Bool)] -> Result a
forall a. Bool -> Int -> [[Int]] -> [(a, Bool)] -> Result a
processRawResult Bool
mex Int
nts)
                                 ([([[Int]], [(a, Bool)])] -> Results a)
-> [([[Int]], [(a, Bool)])] -> Results a
forall a b. (a -> b) -> a -> b
$ [Int] -> (a -> [Bool]) -> [a] -> [([[Int]], [(a, Bool)])]
forall i a. [i] -> (a -> [Bool]) -> [a] -> [([[i]], [(a, Bool)])]
getRawResults [Int]
is a -> [Bool]
pmap [a]
ms
  where is :: [Int]
is = [Int
1..([Property] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Property] -> Int) -> [Property] -> Int
forall a b. (a -> b) -> a -> b
$ a -> [Property]
ps a
f)]
        pmap :: a -> [Bool]
pmap a
f = [Property] -> Int -> [Bool]
propertiesToMap (a -> [Property]
ps a
f) Int
nts
        ms' :: [a]
ms' = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Int
nmsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ([a] -> [a]
forall a. [a] -> [a]
tail ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a -> [a]
forall a. Mutable a => a -> [a]
mutants a
f)
        mex :: Bool
mex = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ms' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
nms
        ms :: [a]
ms = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
nms [a]
ms' [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ems

getResultsExtraTimeout :: (Mutable a)
                       => Int
                       -> [a]
                       -> a -> (a -> [Property]) -> Int -> Int
                       -> IO (Results a)
getResultsExtraTimeout :: Int
-> [a] -> a -> (a -> [Property]) -> Int -> Int -> IO (Results a)
getResultsExtraTimeout Int
0 [a]
ems a
f a -> [Property]
ps Int
m Int
n = Results a -> IO (Results a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Results a -> IO (Results a)) -> Results a -> IO (Results a)
forall a b. (a -> b) -> a -> b
$ [a] -> a -> (a -> [Property]) -> Int -> Int -> Results a
forall a.
Mutable a =>
[a] -> a -> (a -> [Property]) -> Int -> Int -> Results a
getResultsExtra [a]
ems a
f a -> [Property]
ps Int
m Int
n
getResultsExtraTimeout Int
t [a]
ems a
f a -> [Property]
ps Int
nm0 Int
nt0 = Int -> [Results a] -> IO (Results a)
forall a. Int -> [a] -> IO a
lastTimeout Int
t [Results a]
resultss
  where
    resultss :: [Results a]
resultss = ((Results a, [Int]) -> Results a)
-> [(Results a, [Int])] -> [Results a]
forall a b. (a -> b) -> [a] -> [b]
map (Results a, [Int]) -> Results a
forall a b. (a, b) -> a
fst
             ([(Results a, [Int])] -> [Results a])
-> [(Results a, [Int])] -> [Results a]
forall a b. (a -> b) -> a -> b
$ ((Results a, [Int]) -> (Int, [Int]))
-> [(Results a, [Int])] -> [(Results a, [Int])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
takeWhileIncreasingOn ((Result a -> Int
forall a. Result a -> Int
totalMutants (Result a -> Int) -> (Results a -> Result a) -> Results a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Results a -> Result a
forall a. [a] -> a
head) (Results a -> Int)
-> ([Int] -> [Int]) -> (Results a, [Int]) -> (Int, [Int])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
*** [Int] -> [Int]
forall a. a -> a
id)
             [ ([a] -> a -> (a -> [Property]) -> Int -> Int -> Results a
forall a.
Mutable a =>
[a] -> a -> (a -> [Property]) -> Int -> Int -> Results a
getResultsExtra [a]
ems a
f a -> [Property]
ps Int
nm Int
nt, Int -> [Property] -> [Int]
propertiesNTests Int
nt ([Property] -> [Int]) -> [Property] -> [Int]
forall a b. (a -> b) -> a -> b
$ a -> [Property]
ps a
f)
             | (Int
nm,Int
nt) <- ((Int, Int) -> (Int, Int)) -> (Int, Int) -> [(Int, Int)]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Int
forall a. Integral a => a -> a
incHalf (Int -> Int) -> (Int -> Int) -> (Int, Int) -> (Int, Int)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
*** Int -> Int
forall a. Integral a => a -> a
incHalf) (Int
nm0,Int
nt0) ]
    incHalf :: a -> a
incHalf a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
x a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2

processRawResult :: Bool -> Int -> [[Int]] -> [(a,Bool)] -> Result a
processRawResult :: Bool -> Int -> [[Int]] -> [(a, Bool)] -> Result a
processRawResult Bool
mex Int
nt [[Int]]
iss [(a, Bool)]
mhs = Result :: forall a.
[[Int]]
-> [Int]
-> [a]
-> Maybe a
-> Int
-> Int
-> Int
-> Int
-> Int
-> Bool
-> Result a
Result
  { sets :: [[Int]]
sets      = [[Int]] -> [[Int]]
forall i. Eq i => [[i]] -> [[i]]
relevantPropertySets [[Int]]
iss
  , implied :: [Int]
implied   = [[Int]] -> [Int]
forall i. Eq i => [[i]] -> [i]
relevantImplications [[Int]]
iss
  , survivors :: [a]
survivors = [a]
ms
  , smallestSurvivor :: Maybe a
smallestSurvivor = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe [a]
ms
  , nSurvivors :: Int
nSurvivors   = Int
ns
  , nKilled :: Int
nKilled      = Int
nk
  , totalMutants :: Int
totalMutants = Int
nm
  , score :: Int
score        = Int
nkInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
100 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
nm
  , maxTests :: Int
maxTests     = Int
nt
  , mutantsExhausted :: Bool
mutantsExhausted = Bool
mex
  }
  where ms :: [a]
ms = [a
m | (a
m,Bool
h) <- [(a, Bool)]
mhs, Bool
h]
        nm :: Int
nm = [(a, Bool)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, Bool)]
mhs
        ns :: Int
ns = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ms
        nk :: Int
nk = Int
nm Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ns

minimal :: Results a -> Bool
minimal :: Results a -> Bool
minimal (Result a
r:Results a
_) = [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Result a -> [Int]
forall a. Result a -> [Int]
implied Result a
r)
             Bool -> Bool -> Bool
&& [[Int]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Result a -> [[Int]]
forall a. Result a -> [[Int]]
sets Result a
r) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1

complete :: Results a -> Bool
complete :: Results a -> Bool
complete (Result a
r:Results a
_) = Result a -> Int
forall a. Result a -> Int
nSurvivors Result a
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

relevantPropertySets :: Eq i => [[i]] -> [[i]]
relevantPropertySets :: [[i]] -> [[i]]
relevantPropertySets = ([i] -> [i] -> Bool) -> [[i]] -> [[i]]
forall a. (a -> a -> Bool) -> [a] -> [a]
filterU (Bool -> Bool
not (Bool -> Bool) -> ([i] -> [i] -> Bool) -> [i] -> [i] -> Bool
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
... [i] -> [i] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
contained) ([[i]] -> [[i]]) -> ([[i]] -> [[i]]) -> [[i]] -> [[i]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([i] -> Int) -> [[i]] -> [[i]]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn [i] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

relevantImplications :: Eq i => [[i]] -> [i]
relevantImplications :: [[i]] -> [i]
relevantImplications [[i]]
iss = ([i] -> [i] -> [i]) -> [i] -> [[i]] -> [i]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [i] -> [i] -> [i]
forall a. Eq a => [a] -> [a] -> [a]
union [] [[i]]
iss
                        [i] -> [i] -> [i]
forall a. Eq a => [a] -> [a] -> [a]
\\ ([i] -> [i] -> [i]) -> [i] -> [[i]] -> [i]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [i] -> [i] -> [i]
forall a. Eq a => [a] -> [a] -> [a]
union [] ([[i]] -> [[i]]
forall i. Eq i => [[i]] -> [[i]]
relevantPropertySets [[i]]
iss)

-- | Returns a description of property sets, grouping the ones that had the
--   same surviving mutants.  The resulting list is ordered starting with the
--   least surviving mutants to the most surviving mutants.
--
-- Arguments:
--
-- * @is@: list of property ids (@length is == length (pmap x)@)
--
-- * @pmap@: a property map
--
-- * @ms@: list of mutants to apply to the property map
--
-- Return a list of tuples containing:
--
--   * a list of property sets
--   * a list of mutants paired with booleans indicating whether each survived
getRawResults :: [i] -> (a -> [Bool]) -> [a] -> [([[i]],[(a,Bool)])]
getRawResults :: [i] -> (a -> [Bool]) -> [a] -> [([[i]], [(a, Bool)])]
getRawResults [i]
is a -> [Bool]
ps [a]
ms = ([[i]] -> [[i]]
forall a. a -> a
id ([[i]] -> [[i]])
-> ([Bool] -> [(a, Bool)])
-> ([[i]], [Bool])
-> ([[i]], [(a, Bool)])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
*** ([a] -> [Bool] -> [(a, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ms)) (([[i]], [Bool]) -> ([[i]], [(a, Bool)]))
-> [([[i]], [Bool])] -> [([[i]], [(a, Bool)])]
forall a b. (a -> b) -> [a] -> [b]
`map` [i] -> (a -> [Bool]) -> [a] -> [([[i]], [Bool])]
forall i a. [i] -> (a -> [Bool]) -> [a] -> [([[i]], [Bool])]
getRawResults' [i]
is a -> [Bool]
ps [a]
ms

-- | Returns a description of property sets, grouping the ones that had the
--   same surviving mutants.  The resulting list is ordered starting with the
--   least surviving mutants to the most surviving mutants.
--
-- Arguments:
--
-- * @is@: list of property ids (@length is == length (pmap x)@)
--
-- * @pmap@: a property map
--
-- * @ms@: list of mutants to apply to the property map
--
-- Return a list of tuples containing:
--
--   * a list of property sets
--   * a boolean list indicating whether a given mutant survived
getRawResults' :: [i] -> (a -> [Bool]) -> [a] -> [([[i]],[Bool])]
getRawResults' :: [i] -> (a -> [Bool]) -> [a] -> [([[i]], [Bool])]
getRawResults' [i]
is a -> [Bool]
pmap = (([[i]], [Bool]) -> Int) -> [([[i]], [Bool])] -> [([[i]], [Bool])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((Bool -> Bool) -> [Bool] -> Int
forall a. (a -> Bool) -> [a] -> Int
count Bool -> Bool
forall a. a -> a
id ([Bool] -> Int)
-> (([[i]], [Bool]) -> [Bool]) -> ([[i]], [Bool]) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[i]], [Bool]) -> [Bool]
forall a b. (a, b) -> b
snd)
                       ([([[i]], [Bool])] -> [([[i]], [Bool])])
-> ([a] -> [([[i]], [Bool])]) -> [a] -> [([[i]], [Bool])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [([i], [Bool])] -> [([[i]], [Bool])]
forall b a. Ord b => [(a, b)] -> [([a], b)]
sortAndGroupFstBySnd
                       ([([i], [Bool])] -> [([[i]], [Bool])])
-> ([a] -> [([i], [Bool])]) -> [a] -> [([[i]], [Bool])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[i]] -> [[Bool]] -> [([i], [Bool])]
forall a b. [a] -> [b] -> [(a, b)]
zip ([i] -> [[i]]
forall a. [a] -> [[a]]
subsets [i]
is)
                       ([[Bool]] -> [([i], [Bool])])
-> ([a] -> [[Bool]]) -> [a] -> [([i], [Bool])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Bool]] -> [[Bool]]
forall a. [[a]] -> [[a]]
transpose
                       ([[Bool]] -> [[Bool]]) -> ([a] -> [[Bool]]) -> [a] -> [[Bool]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [Bool]) -> [a] -> [[Bool]]
forall a b. (a -> b) -> [a] -> [b]
map ([Bool] -> [Bool]
compositions ([Bool] -> [Bool]) -> (a -> [Bool]) -> a -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Bool]
pmap)

-- | @nSurv props fs@ returns the number of values that match
--   compositions of properties on the property map.
--
-- * @props@ should be a function from a value to a list of properties that
--   match that value (in the case of functions, functions that "survive" those
--   properties).
--
-- * @fs@ is a list of values to be mapped over by @props@
--
-- > length (nSurvivors props fs)  ==  2 ^ (length (props fs))
--
-- This function is otherwise unused in this file.  It is just a simpler
-- version of 'pssurv' to serve as documentation.
--
-- It is also not exported!
nSurv :: (a -> [Bool]) -> [a] -> [Int]
nSurv :: (a -> [Bool]) -> [a] -> [Int]
nSurv a -> [Bool]
props = ([Bool] -> Int) -> [[Bool]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Bool -> Bool) -> [Bool] -> Int
forall a. (a -> Bool) -> [a] -> Int
count Bool -> Bool
forall a. a -> a
id)
            ([[Bool]] -> [Int]) -> ([a] -> [[Bool]]) -> [a] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Bool]] -> [[Bool]]
forall a. [[a]] -> [[a]]
transpose
            ([[Bool]] -> [[Bool]]) -> ([a] -> [[Bool]]) -> [a] -> [[Bool]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [Bool]) -> [a] -> [[Bool]]
forall a b. (a -> b) -> [a] -> [b]
map ([Bool] -> [Bool]
compositions ([Bool] -> [Bool]) -> (a -> [Bool]) -> a -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Bool]
props)


data Conjecture = Conjecture
  { Conjecture -> Bool
isEq        :: Bool
  , Conjecture -> Bool
isIm        :: Bool
  , Conjecture -> [Int]
cleft       :: [Int]
  , Conjecture -> [Int]
cright      :: [Int]
  , Conjecture -> Int
cscore      :: Int
  , Conjecture -> Int
cnKilled    :: Int
  , Conjecture -> Int
cnSurvivors :: Int
  } deriving Int -> Conjecture -> String -> String
[Conjecture] -> String -> String
Conjecture -> String
(Int -> Conjecture -> String -> String)
-> (Conjecture -> String)
-> ([Conjecture] -> String -> String)
-> Show Conjecture
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Conjecture] -> String -> String
$cshowList :: [Conjecture] -> String -> String
show :: Conjecture -> String
$cshow :: Conjecture -> String
showsPrec :: Int -> Conjecture -> String -> String
$cshowsPrec :: Int -> Conjecture -> String -> String
Show

conjectures :: [Result a] -> [Conjecture]
conjectures :: [Result a] -> [Conjecture]
conjectures = (Result a -> [Conjecture]) -> [Result a] -> [Conjecture]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Result a -> [Conjecture]
forall a. Result a -> [Conjecture]
conjectures1
            ([Result a] -> [Conjecture])
-> ([Result a] -> [Result a]) -> [Result a] -> [Conjecture]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Result a -> Int) -> [Result a] -> [Result a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> (Result a -> Int) -> Result a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
50Int -> Int -> Int
forall a. Num a => a -> a -> a
-) (Int -> Int) -> (Result a -> Int) -> Result a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result a -> Int
forall a. Result a -> Int
score) -- closer to 50 the better!
            ([Result a] -> [Result a])
-> ([Result a] -> [Result a]) -> [Result a] -> [Result a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Result a] -> [Result a]
forall a. [Result a] -> [Result a]
reduceImplications
            ([Result a] -> [Result a])
-> ([Result a] -> [Result a]) -> [Result a] -> [Result a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Result a] -> [Result a]
forall a. [Result a] -> [Result a]
filterNonCanon
            ([Result a] -> [Result a])
-> ([Result a] -> [Result a]) -> [Result a] -> [Result a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Result a] -> [Result a]
forall a. [a] -> [a]
reverse

conjectures1 :: Result a -> [Conjecture]
conjectures1 :: Result a -> [Conjecture]
conjectures1 Result a
r = [ [Int]
p [Int] -> [Int] -> Conjecture
`eq` [Int]
p' | [Int]
p' <- [[Int]]
ps ]
              [Conjecture] -> [Conjecture] -> [Conjecture]
forall a. [a] -> [a] -> [a]
++ [ [Int]
p [Int] -> [Int] -> Conjecture
`im` [Int]
i  | (Bool -> Bool
not(Bool -> Bool) -> ([Int] -> Bool) -> [Int] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [Int]
i ]
  where
    ([Int]
p:[[Int]]
ps) = Result a -> [[Int]]
forall a. Result a -> [[Int]]
sets Result a
r
    i :: [Int]
i      = Result a -> [Int]
forall a. Result a -> [Int]
implied Result a
r
    eq :: [Int] -> [Int] -> Conjecture
eq     = Bool -> [Int] -> [Int] -> Conjecture
conj Bool
True
    im :: [Int] -> [Int] -> Conjecture
im     = Bool -> [Int] -> [Int] -> Conjecture
conj Bool
False
    conj :: Bool -> [Int] -> [Int] -> Conjecture
conj Bool
isE [Int]
p [Int]
p' = Conjecture :: Bool -> Bool -> [Int] -> [Int] -> Int -> Int -> Int -> Conjecture
Conjecture
      { isEq :: Bool
isEq        = Bool
isE
      , isIm :: Bool
isIm        = Bool -> Bool
not Bool
isE
      , cleft :: [Int]
cleft       = [Int]
p
      , cright :: [Int]
cright      = [Int]
p'
      , cscore :: Int
cscore      = Result a -> Int
forall a. Result a -> Int
score Result a
r
      , cnKilled :: Int
cnKilled    = Result a -> Int
forall a. Result a -> Int
nKilled Result a
r
      , cnSurvivors :: Int
cnSurvivors = Result a -> Int
forall a. Result a -> Int
nSurvivors Result a
r
      }
-- TODO: improve implication score
-- implication score can be improved by
-- by separating each implication on its own:
--   [4] ==> [2,3]
-- become
--   [4] ==> [2]
--   [4] ==> [3]
-- Then evaluating percentage of occurences of True ==> True and other cases