{-# LANGUAGE CPP #-}
-- |
-- Module      : Test.LeanCheck.Stats
-- Copyright   : (c) 2017-2020 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- This module is part of LeanCheck,
-- a simple enumerative property-based testing library.
--
-- This module exports functions to compute statistics of Listable instances.
module Test.LeanCheck.Stats
  ( classStats
  , classStatsT
  , conditionStats
  , conditionStatsT

  , classify
  , classifyBy
  , classifyOn
  , counts
  , countsBy
  , countsOn
  )
where

import Test.LeanCheck.Core
import Data.Function (on)
#ifndef __HUGS__
import Data.List (intercalate, transpose)
#else
import Data.List (transpose)

intercalate :: [a] -> [[a]] -> [a]
intercalate xs xss  =  concat (intersperse xs xss)
  where
  intersperse :: a -> [a] -> [a]
  intersperse _ []        =  []
  intersperse sep (x:xs)  =  x : prependToAll sep xs
    where
    prependToAll :: a -> [a] -> [a]
    prependToAll _   []      =  []
    prependToAll sep (x:xs)  =  sep : x : prependToAll sep xs
#endif

-- | Prints statistics about a given 'Listable' generator
--   up to a number of test values.
--
-- For example,
-- to know the distribution of the length of generated lists,
-- just run:
--
-- > > classStats 100 (length :: [Int] -> Int)
-- > 0:  1/100  1%
-- > 1:  6/100  6%
-- > 2: 16/100 16%
-- > 3: 25/100 25%
-- > 4: 26/100 26%
-- > 5: 18/100 18%
-- > 6:  7/100  7%
-- > 7:  1/100  1%
--
-- This provides similar functionality to QuickCheck's
-- label, collect, classify and tabulate
-- while keeping statistics separate from your properties.
classStats :: (Listable a, Show b) => Int -> (a -> b) -> IO ()
classStats :: forall a b. (Listable a, Show b) => Int -> (a -> b) -> IO ()
classStats Int
n a -> b
f  =  [Char] -> IO ()
putStrLn
                forall b c a. (b -> c) -> (a -> b) -> a -> c
.  [Char] -> [[[Char]]] -> [Char]
table [Char]
" "
                forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a b. (a -> b) -> [a] -> [b]
map ([Char], Int) -> [[Char]]
showCount
                forall a b. (a -> b) -> a -> b
$  forall b a. Eq b => (a -> b) -> [a] -> [(b, Int)]
countsOn ([Char] -> [Char]
unquote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) [a]
xs
  where
  xs :: [a]
xs  =  forall a. Int -> [a] -> [a]
take Int
n forall a. Listable a => [a]
list
  len :: Int
len  =  forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
  showCount :: ([Char], Int) -> [[Char]]
showCount ([Char]
s,Int
n)  =  [ [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
":"
                      , forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
len
                      , forall a. Show a => a -> [Char]
show (Int
100 forall a. Num a => a -> a -> a
* Int
n forall a. Integral a => a -> a -> a
`div` Int
len) forall a. [a] -> [a] -> [a]
++ [Char]
"%"
                      ]

-- | Same as 'classStats', but separated by 'tiers'.
--
-- The first argument is the number of tiers to evaluate.
--
-- > > classStatsT 6 (length :: [Int] -> Int)
-- >       tot   0  1  2  3  4   5
-- > 
-- > tot:   32   1  1  2  4  8  16
-- >   0:    1   1  0  0  0  0   0
-- >   1:    5   0  1  1  1  1   1
-- >   2:   10   0  0  1  2  3   4
-- >   3:   10   0  0  0  1  3   6
-- >   4:    5   0  0  0  0  1   4
-- >   5:    1   0  0  0  0  0   1
--
-- Lines are values, columns are tiers:
--
-- > > classStatsT 6 and
-- >         tot   0  1  2  3   4   5
-- > 
-- >   tot:   63   1  2  4  8  16  32
-- >  True:    6   1  1  1  1   1   1
-- > False:   57   0  1  3  7  15  31
classStatsT :: (Listable a, Show b) => Int -> (a -> b) -> IO ()
classStatsT :: forall a b. (Listable a, Show b) => Int -> (a -> b) -> IO ()
classStatsT Int
n a -> b
f  =  [Char] -> IO ()
putStrLn
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
.  [Char] -> [[[Char]]] -> [Char]
table [Char]
"  "
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
.  ([[Char]]
headingforall a. a -> [a] -> [a]
:)
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
.  ([[Char]
" "]forall a. a -> [a] -> [a]
:)
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (Show a, Show a) => ([Char], a, [a]) -> [[Char]]
showCounts
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
.  [([Char], Int, [Int])] -> [([Char], Int, [Int])]
prependTotal
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall b a. Eq b => (a -> b) -> [[a]] -> [(b, Int, [Int])]
countsTOn ([Char] -> [Char]
unquote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
                 forall a b. (a -> b) -> a -> b
$  forall a. Int -> [a] -> [a]
take Int
n forall a. Listable a => [[a]]
tiers
  where
  heading :: [[Char]]
heading  =  [Char]
"" forall a. a -> [a] -> [a]
: [Char]
"tot " forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [Int
0..(Int
nforall a. Num a => a -> a -> a
-Int
1)]
  showCounts :: ([Char], a, [a]) -> [[Char]]
showCounts ([Char]
s,a
n,[a]
ns)  =  ([Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
":") forall a. a -> [a] -> [a]
: (forall a. Show a => a -> [Char]
show a
n forall a. [a] -> [a] -> [a]
++ [Char]
" ") forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [a]
ns
  (a
_,b
n,[c]
ns) -+- :: (a, b, [c]) -> (a, b, [c]) -> ([Char], b, [c])
-+- (a
_,b
n',[c]
ns')  =  ([Char]
"tot", b
n forall a. Num a => a -> a -> a
+ b
n', forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(+) [c]
ns [c]
ns')
  totalizeCounts :: [(a, Int, [Int])] -> ([Char], Int, [Int])
totalizeCounts  =  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {b} {c} {a} {a}.
(Num b, Num c) =>
(a, b, [c]) -> (a, b, [c]) -> ([Char], b, [c])
(-+-) (forall a. HasCallStack => a
undefined, Int
0, forall a. a -> [a]
repeat Int
0)
  prependTotal :: [([Char], Int, [Int])] -> [([Char], Int, [Int])]
prependTotal [([Char], Int, [Int])]
cs  =  forall {a}. [(a, Int, [Int])] -> ([Char], Int, [Int])
totalizeCounts [([Char], Int, [Int])]
cs forall a. a -> [a] -> [a]
: [([Char], Int, [Int])]
cs

-- | How many values match each of a list of conditions?
-- 
-- How many odd and even numbers are in the 'Listable' enumeration?
--
-- > > conditionStats 1000 [("odd", odd :: Int -> Bool), ("even", even)]
-- >  odd: 500/1000 50%
-- > even: 500/1000 50%
--
-- How many of the generated lists are ordered?
--
-- > > conditionStats 1000 [("ordered", ordered :: [Int] -> Bool)]
-- > ordered: 131/1000 13%
conditionStats :: Listable a => Int -> [(String,a->Bool)] -> IO ()
conditionStats :: forall a. Listable a => Int -> [([Char], a -> Bool)] -> IO ()
conditionStats Int
n  =  [Char] -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[[Char]]] -> [Char]
table [Char]
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([Char], a -> Bool) -> [[Char]]
show1
  where
  xs :: [a]
xs  =  forall a. Int -> [a] -> [a]
take Int
n forall a. Listable a => [a]
list
  len :: Int
len  =  forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
  show1 :: ([Char], a -> Bool) -> [[Char]]
show1 ([Char]
s,a -> Bool
f)  =  [ [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
":"
                  , forall a. Show a => a -> [Char]
show Int
c forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
len
                  , forall a. Show a => a -> [Char]
show (Int
100 forall a. Num a => a -> a -> a
* Int
c forall a. Integral a => a -> a -> a
`div` Int
len) forall a. [a] -> [a] -> [a]
++ [Char]
"%"
                  ]  where  c :: Int
c = forall {a}. (a -> Bool) -> [a] -> Int
count a -> Bool
f [a]
xs
  count :: (a -> Bool) -> [a] -> Int
count a -> Bool
f  =  forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
f

-- | Same as 'conditionStats' but by tier.
--
-- The first argument is the number of tiers to evaluate.
--
-- How many odd and even numbers are in each tier?
--
-- > > conditionStatsT 10 [("odd", odd :: Int -> Bool), ("even", even)]
-- > total: 1 1 1 1 1 1 1 1 1 1
-- >   odd: 0 1 1 0 0 1 1 0 0 1
-- >  even: 1 0 0 1 1 0 0 1 1 0
--
-- How many ordered lists are in each tier?
--
-- > > conditionStatsT 10 [("ordered", ordered :: [Int] -> Bool)]
-- >   total: 1 1 2 4 8 16 32 64 128 256
-- > ordered: 1 1 2 3 5  7 11 15  22  30
conditionStatsT :: Listable a => Int -> [(String,a->Bool)] -> IO ()
conditionStatsT :: forall a. Listable a => Int -> [([Char], a -> Bool)] -> IO ()
conditionStatsT Int
n  =  [Char] -> IO ()
putStrLn
                   forall b c a. (b -> c) -> (a -> b) -> a -> c
.  [Char] -> [[[Char]]] -> [Char]
table [Char]
" "
                   forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a b. (a -> b) -> [a] -> [b]
map ([Char], a -> Bool) -> [[Char]]
show1
                   forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (([Char]
"total", forall a b. a -> b -> a
const Bool
True)forall a. a -> [a] -> [a]
:)
  where
  xss :: [[a]]
xss  =  forall a. Int -> [a] -> [a]
take Int
n forall a. Listable a => [[a]]
tiers
  show1 :: ([Char], a -> Bool) -> [[Char]]
show1 ([Char]
s,a -> Bool
f)  =  ([Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
":") forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (a -> Bool) -> [a] -> Int
count a -> Bool
f) [[a]]
xss
  count :: (a -> Bool) -> [a] -> Int
count a -> Bool
f  =  forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
f

-- | Classify values using their 'Eq' instance.
--
-- > > classify [1,2,3,1,2,1]
-- > [[1,1,1],[2,2],[3]]
--
-- (cf. 'classifyBy', 'classifyOn')
classify :: Eq a => [a] -> [[a]]
classify :: forall a. Eq a => [a] -> [[a]]
classify  =  forall a. (a -> a -> Bool) -> [a] -> [[a]]
classifyBy forall a. Eq a => a -> a -> Bool
(==)

-- | Classify values by a given comparison function.
--
-- > > classifyBy (\(x,_) (y,_) -> x == y) [(1,1),(1,2),(2,1),(2,2)]
-- > [[(1,1),(1,2)],[(2,1),(2,2)]]
--
-- (cf. 'classify', 'classifyOn')
classifyBy :: (a -> a -> Bool) -> [a] -> [[a]]
classifyBy :: forall a. (a -> a -> Bool) -> [a] -> [[a]]
classifyBy a -> a -> Bool
(==) []      =  []
classifyBy a -> a -> Bool
(==) (a
x:[a]
xs)  =  (a
xforall a. a -> [a] -> [a]
:forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
== a
x) [a]
xs)
                        forall a. a -> [a] -> [a]
:  forall a. (a -> a -> Bool) -> [a] -> [[a]]
classifyBy a -> a -> Bool
(==) (forall a. (a -> Bool) -> [a] -> [a]
filter (a -> a -> Bool
/= a
x) [a]
xs)
  where
  a
x /= :: a -> a -> Bool
/= a
y  =  Bool -> Bool
not (a
x a -> a -> Bool
== a
y)

-- | Classify values based on the result of a given function.
--
-- > > classifyOn head ["sheep", "chip", "ship", "cheap"]
-- > [["sheep","ship"],["chip","cheap"]]
--
-- > > classifyOn odd [1,2,3,4,5,6]
-- > [[1,3,5],[2,4,6]]
--
-- (cf. 'classify', 'classifyBy')
classifyOn :: Eq b => (a -> b) -> [a] -> [[a]]
classifyOn :: forall b a. Eq b => (a -> b) -> [a] -> [[a]]
classifyOn a -> b
f [a]
xs  =  forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst)
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. (a -> a -> Bool) -> [a] -> [[a]]
classifyBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> b
snd)
                 forall a b. (a -> b) -> a -> b
$  forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> (a
x,a -> b
f a
x)) [a]
xs

-- | Returns the counts of each value in a list.
--
-- > > counts "Mississippi"
-- > [('M',1),('i',4),('s',4),('p',2)]
--
-- Values are returned in the order they appear.
counts :: Eq a => [a] -> [(a,Int)]
counts :: forall a. Eq a => [a] -> [(a, Int)]
counts  =  forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> (a, Int)
headLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [[a]]
classify

-- | Returns the counts of each value in a list
--   using a given comparison function.
countsBy :: (a -> a -> Bool) -> [a] -> [(a,Int)]
countsBy :: forall a. (a -> a -> Bool) -> [a] -> [(a, Int)]
countsBy a -> a -> Bool
(==)  =  forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> (a, Int)
headLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
classifyBy a -> a -> Bool
(==)

-- | Returns the counts of each value in a list
--   based on a projection.
--
-- > > countsOn length ["sheep", "chip", "ship", "cheap", "Mississippi"]
-- > [(5,2),(4,2),(11,1)]
countsOn :: Eq b => (a -> b) -> [a] -> [(b,Int)]
countsOn :: forall b a. Eq b => (a -> b) -> [a] -> [(b, Int)]
countsOn a -> b
f  =  forall a b. (a -> b) -> [a] -> [b]
map (\[a]
xs -> (a -> b
f forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [a]
xs, forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Eq b => (a -> b) -> [a] -> [[a]]
classifyOn a -> b
f

countsT :: Eq a => [[a]] -> [(a,Int,[Int])]
countsT :: forall a. Eq a => [[a]] -> [(a, Int, [Int])]
countsT [[a]]
xss  =  [(a
x,Int
n,forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. Eq a => a -> [a] -> Int
count a
x) [[a]]
xss) | (a
x,Int
n) <- forall a. Eq a => [a] -> [(a, Int)]
counts (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
xss)]
  where
  count :: a -> [a] -> Int
count a
x  =  forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
== a
x)

countsTOn :: Eq b => (a -> b) -> [[a]] -> [(b,Int,[Int])]
countsTOn :: forall b a. Eq b => (a -> b) -> [[a]] -> [(b, Int, [Int])]
countsTOn a -> b
f  =  forall a. Eq a => [[a]] -> [(a, Int, [Int])]
countsT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [[a]] -> [[b]]
mapT a -> b
f

headLength :: [a] -> (a,Int)
headLength :: forall a. [a] -> (a, Int)
headLength [a]
xs  =  (forall a. [a] -> a
head [a]
xs, forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)

unquote :: String -> String
unquote :: [Char] -> [Char]
unquote (Char
'"':[Char]
s) | forall a. [a] -> a
last [Char]
s forall a. Eq a => a -> a -> Bool
== Char
'"'  =  forall a. [a] -> [a]
init [Char]
s
unquote [Char]
s  =  [Char]
s

table :: String -> [[String]] -> String
table :: [Char] -> [[[Char]]] -> [Char]
table [Char]
s []   =  [Char]
""
table [Char]
s [[[Char]]]
sss  =  [[Char]] -> [Char]
unlines
             forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a b. (a -> b) -> [a] -> [b]
map (forall a. Eq a => a -> [a] -> [a]
removeTrailing Char
' ')
             forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [[a]] -> [a]
intercalate [Char]
s)
             forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. [[a]] -> [[a]]
transpose
             forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [[a]] -> [[a]]
normalize Char
' ')
             forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. [a] -> [a] -> [a]
(++))
             forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [[a]] -> [[a]]
normalize [Char]
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [[Char]]
lines)
             forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. a -> [[a]] -> [[a]]
normalize [Char]
""
             forall a b. (a -> b) -> a -> b
$  [[[Char]]]
sss

-- | Fits a list to a certain width by appending a certain value
--
-- > fit ' ' 6 "str" == "str   "
--
-- > fit 0 6 [1,2,3] == [1,2,3,0,0,0]
fit :: a -> Int -> [a] -> [a]
fit :: forall a. a -> Int -> [a] -> [a]
fit a
x Int
n [a]
xs  =  forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) a
x forall a. [a] -> [a] -> [a]
++ [a]
xs

-- | normalize makes all list the same length by adding a value
--
-- > normalize ["asdf","qw","er"] == normalize ["asdf","qw  ","er  "]
normalize :: a -> [[a]] -> [[a]]
normalize :: forall a. a -> [[a]] -> [[a]]
normalize a
x [[a]]
xs  =  forall a b. (a -> b) -> [a] -> [b]
map (a
x forall a. a -> Int -> [a] -> [a]
`fit` forall a. [[a]] -> Int
maxLength [[a]]
xs) [[a]]
xs

-- | Given a list of lists returns the maximum length
maxLength :: [[a]] -> Int
maxLength :: forall a. [[a]] -> Int
maxLength  =  forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
0forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length

removeTrailing :: Eq a => a -> [a] -> [a]
removeTrailing :: forall a. Eq a => a -> [a] -> [a]
removeTrailing a
x  =  forall a. [a] -> [a]
reverse
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==a
x)
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. [a] -> [a]
reverse