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

partitionStats :: [F.FInfo a] -> Maybe Stats
partitionStats :: [FInfo a] -> Maybe Stats
partitionStats [FInfo a]
fis = Maybe Stats
info
  where
    css :: [[Integer]]
css            = [HashMap Integer (SubC a) -> [Integer]
forall k v. HashMap k v -> [k]
M.keys (HashMap Integer (SubC a) -> [Integer])
-> HashMap Integer (SubC a) -> [Integer]
forall a b. (a -> b) -> a -> b
$ FInfo a -> HashMap Integer (SubC a)
forall (c :: * -> *) a. GInfo c a -> HashMap Integer (c a)
F.cm FInfo a
fi | FInfo a
fi <- [FInfo a]
fis]
    sizes :: [Float]
sizes          = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float) -> ([Integer] -> Int) -> [Integer] -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Integer] -> Float) -> [[Integer]] -> [Float]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Integer]]
css
    info :: Maybe Stats
info           = Maybe Stats -> ([Float] -> Maybe Stats) -> [Float] -> Maybe Stats
forall b a. b -> ([a] -> b) -> [a] -> b
applyNonNull Maybe Stats
forall a. Maybe a
Nothing (Stats -> Maybe Stats
forall a. a -> Maybe a
Just (Stats -> Maybe Stats)
-> ([Float] -> Stats) -> [Float] -> Maybe Stats
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
(Int -> Stats -> ShowS)
-> (Stats -> String) -> ([Stats] -> ShowS) -> Show Stats
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. Stats -> Rep Stats x)
-> (forall x. Rep Stats x -> Stats) -> Generic Stats
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
<+> Float -> Doc
forall a. PPrint a => a -> Doc
pprint (Stats -> Float
cMax   Stats
s) Doc -> Doc -> Doc
<+> Doc
"/" Doc -> Doc -> Doc
<+> Float -> Doc
forall a. PPrint a => a -> Doc
pprint (Stats -> Float
cTotal Stats
s)
         , Doc
"STAT: freqs     =" Doc -> Doc -> Doc
<+> [(Float, Int)] -> Doc
forall a. PPrint a => a -> Doc
pprint (Stats -> [(Float, Int)]
cFreq  Stats
s)
         , Doc
"STAT: average   =" Doc -> Doc -> Doc
<+> Float -> Doc
forall a. PPrint a => a -> Doc
pprint (Stats -> Float
cMean  Stats
s)
         , Doc
"STAT: speed     =" Doc -> Doc -> Doc
<+> Float -> Doc
forall a. PPrint a => a -> Doc
pprint (Stats -> Float
cSpeed Stats
s)
         ]

mkStats :: [Float] -> Stats
mkStats :: [Float] -> Stats
mkStats [Float]
ns  = Stats :: [Float]
-> [(Float, Int)] -> Float -> Float -> Float -> Float -> Stats
Stats {
    cSizes :: [Float]
cSizes  = [Float]
ns
  , cFreq :: [(Float, Int)]
cFreq   = [Float] -> [(Float, Int)]
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 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
maxx
  }
  where
    maxx :: Float
maxx    = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float]
ns
    total :: Float
total   = [Float] -> Float
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 :: [a] -> [(a, Int)]
frequency = ([a] -> (a, Int)) -> [[a]] -> [(a, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ([a] -> a
forall a. [a] -> a
head ([a] -> a) -> ([a] -> Int) -> [a] -> (a, Int)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[a]] -> [(a, Int)]) -> ([a] -> [[a]]) -> [a] -> [(a, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
group ([a] -> [[a]]) -> ([a] -> [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
sort

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