{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

-- | This module implements functions that print out
--   statistics about the constraints.
module Language.Fixpoint.Utils.Statistics (statistics) where

import           Control.DeepSeq
import           GHC.Generics
import           Control.Arrow ((&&&))

import           Language.Fixpoint.Misc                (donePhase, Moods(..), applyNonNull)
import           Language.Fixpoint.Types.Config
import           Language.Fixpoint.Types.PrettyPrint
import           Language.Fixpoint.Graph (partition')
import qualified Language.Fixpoint.Types        as F
import qualified Data.HashMap.Strict            as M
import           Data.List (sort,group)
import           Text.PrettyPrint.HughesPJ

statistics :: Config -> F.FInfo a -> IO (F.Result (Integer, a))
statistics :: forall a. Config -> FInfo a -> IO (Result (Integer, a))
statistics Config
_ FInfo a
fi = do
  let fis :: [FInfo a]
fis = forall (c :: * -> *) a.
TaggedC c a =>
Maybe MCInfo -> GInfo c a -> [GInfo c a]
partition' forall a. Maybe a
Nothing FInfo a
fi
  String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ Doc -> String
render forall a b. (a -> b) -> a -> b
$ forall a. PPrint a => a -> Doc
pprint forall a b. (a -> b) -> a -> b
$ forall a. [FInfo a] -> Maybe Stats
partitionStats [FInfo a]
fis
  Moods -> String -> IO ()
donePhase Moods
Loud String
"Statistics"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty

partitionStats :: [F.FInfo a] -> Maybe Stats
partitionStats :: forall a. [FInfo a] -> Maybe Stats
partitionStats [FInfo a]
fis = Maybe Stats
info
  where
    css :: [[Integer]]
css            = [forall k v. HashMap k v -> [k]
M.keys forall a b. (a -> b) -> a -> b
$ forall (c :: * -> *) a. GInfo c a -> HashMap Integer (c a)
F.cm FInfo a
fi | FInfo a
fi <- [FInfo a]
fis]
    sizes :: [Float]
sizes          = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Integer]]
css
    info :: Maybe Stats
info           = forall b a. b -> ([a] -> b) -> [a] -> b
applyNonNull forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Float] -> Stats
mkStats) [Float]
sizes

-------------------------------------------------------------------------------------
-------------------------------------------------------------------------------------
-------------------------------------------------------------------------------------

data Stats = Stats { Stats -> [Float]
cSizes  :: [Float]
                   , Stats -> [(Float, Int)]
cFreq   :: [(Float, Int)]
                   , Stats -> Float
cTotal  :: !Float
                   , Stats -> Float
cMean   :: !Float
                   , Stats -> Float
cMax    :: !Float
                   , Stats -> Float
cSpeed  :: !Float
                   } deriving (Int -> Stats -> ShowS
[Stats] -> ShowS
Stats -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stats] -> ShowS
$cshowList :: [Stats] -> ShowS
show :: Stats -> String
$cshow :: Stats -> String
showsPrec :: Int -> Stats -> ShowS
$cshowsPrec :: Int -> Stats -> ShowS
Show, forall x. Rep Stats x -> Stats
forall x. Stats -> Rep Stats x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Stats x -> Stats
$cfrom :: forall x. Stats -> Rep Stats x
Generic)

instance NFData Stats

instance PPrint Stats where
  pprintTidy :: Tidy -> Stats -> Doc
pprintTidy Tidy
_ Stats
s =
    [Doc] -> Doc
vcat [ Doc
"STAT: max/total =" Doc -> Doc -> Doc
<+> forall a. PPrint a => a -> Doc
pprint (Stats -> Float
cMax   Stats
s) Doc -> Doc -> Doc
<+> Doc
"/" Doc -> Doc -> Doc
<+> forall a. PPrint a => a -> Doc
pprint (Stats -> Float
cTotal Stats
s)
         , Doc
"STAT: freqs     =" Doc -> Doc -> Doc
<+> forall a. PPrint a => a -> Doc
pprint (Stats -> [(Float, Int)]
cFreq  Stats
s)
         , Doc
"STAT: average   =" Doc -> Doc -> Doc
<+> forall a. PPrint a => a -> Doc
pprint (Stats -> Float
cMean  Stats
s)
         , Doc
"STAT: speed     =" Doc -> Doc -> Doc
<+> forall a. PPrint a => a -> Doc
pprint (Stats -> Float
cSpeed Stats
s)
         ]

mkStats :: [Float] -> Stats
mkStats :: [Float] -> Stats
mkStats [Float]
ns  = Stats {
    cSizes :: [Float]
cSizes  = [Float]
ns
  , cFreq :: [(Float, Int)]
cFreq   = forall a. Ord a => [a] -> [(a, Int)]
frequency [Float]
ns
  , cTotal :: Float
cTotal  = Float
total
  , cMean :: Float
cMean   = Float
avg
  , cMax :: Float
cMax    = Float
maxx
  , cSpeed :: Float
cSpeed  = Float
total forall a. Fractional a => a -> a -> a
/ Float
maxx
  }
  where
    maxx :: Float
maxx    = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float]
ns
    total :: Float
total   = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum  [Float]
ns
    avg :: Float
avg     = [Float] -> Float
mean [Float]
ns

frequency :: (Ord a) => [a] -> [(a, Int)]
frequency :: forall a. Ord a => [a] -> [(a, Int)]
frequency = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> a
head forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [[a]]
group forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort

mean :: [Float] -> Float
mean :: [Float] -> Float
mean [Float]
ns  = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Float]
ns forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
ns)