{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Eventlog.Prune
  ( pruneBands, pruneDetailed
  ) where

import Data.List (sortBy)
import Data.Ord (comparing)
import Eventlog.Types
import Data.Map (Map, fromList, (!), toList)

import Eventlog.Args (Args(..), Sort(..))
import Data.Maybe

type Compare a = a -> a -> Ordering

getComparison :: Args -> Compare (Bucket, BucketInfo)
getComparison :: Args -> Compare (Bucket, BucketInfo)
getComparison Args { sorting :: Args -> Sort
sorting = Sort
Size,   reversing :: Args -> Bool
reversing = Bool
False }  = Compare (Bucket, BucketInfo)
cmpSizeDescending
getComparison Args { sorting :: Args -> Sort
sorting = Sort
Size,   reversing :: Args -> Bool
reversing = Bool
True } = Compare (Bucket, BucketInfo)
cmpSizeAscending
getComparison Args { sorting :: Args -> Sort
sorting = Sort
StdDev, reversing :: Args -> Bool
reversing = Bool
False }  = Compare (Bucket, BucketInfo)
cmpStdDevDescending
getComparison Args { sorting :: Args -> Sort
sorting = Sort
StdDev, reversing :: Args -> Bool
reversing = Bool
True } = Compare (Bucket, BucketInfo)
cmpStdDevAscending
getComparison Args { sorting :: Args -> Sort
sorting = Sort
Name,   reversing :: Args -> Bool
reversing = Bool
True }  = Compare (Bucket, BucketInfo)
cmpNameDescending
getComparison Args { sorting :: Args -> Sort
sorting = Sort
Name,   reversing :: Args -> Bool
reversing = Bool
False } = Compare (Bucket, BucketInfo)
cmpNameAscending
getComparison Args { sorting :: Args -> Sort
sorting = Sort
Gradient,   reversing :: Args -> Bool
reversing = Bool
True }  = Compare (Bucket, BucketInfo)
cmpGradientAscending
getComparison Args { sorting :: Args -> Sort
sorting = Sort
Gradient,   reversing :: Args -> Bool
reversing = Bool
False } = Compare (Bucket, BucketInfo)
cmpGradientDescending

cmpNameAscending, cmpNameDescending,
  cmpStdDevAscending, cmpStdDevDescending,
  cmpSizeAscending, cmpSizeDescending,
  cmpGradientAscending, cmpGradientDescending :: Compare (Bucket, BucketInfo)
cmpNameAscending :: Compare (Bucket, BucketInfo)
cmpNameAscending = ((Bucket, BucketInfo) -> Bucket) -> Compare (Bucket, BucketInfo)
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Bucket, BucketInfo) -> Bucket
forall a b. (a, b) -> a
fst
cmpNameDescending :: Compare (Bucket, BucketInfo)
cmpNameDescending = Compare (Bucket, BucketInfo) -> Compare (Bucket, BucketInfo)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Compare (Bucket, BucketInfo)
cmpNameAscending
cmpStdDevAscending :: Compare (Bucket, BucketInfo)
cmpStdDevAscending = ((Bucket, BucketInfo) -> Double) -> Compare (Bucket, BucketInfo)
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (BucketInfo -> Double
bucketStddev (BucketInfo -> Double)
-> ((Bucket, BucketInfo) -> BucketInfo)
-> (Bucket, BucketInfo)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bucket, BucketInfo) -> BucketInfo
forall a b. (a, b) -> b
snd)
cmpStdDevDescending :: Compare (Bucket, BucketInfo)
cmpStdDevDescending = Compare (Bucket, BucketInfo) -> Compare (Bucket, BucketInfo)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Compare (Bucket, BucketInfo)
cmpStdDevAscending
cmpSizeAscending :: Compare (Bucket, BucketInfo)
cmpSizeAscending = ((Bucket, BucketInfo) -> Double) -> Compare (Bucket, BucketInfo)
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (BucketInfo -> Double
bucketTotal (BucketInfo -> Double)
-> ((Bucket, BucketInfo) -> BucketInfo)
-> (Bucket, BucketInfo)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bucket, BucketInfo) -> BucketInfo
forall a b. (a, b) -> b
snd)
cmpSizeDescending :: Compare (Bucket, BucketInfo)
cmpSizeDescending = Compare (Bucket, BucketInfo) -> Compare (Bucket, BucketInfo)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Compare (Bucket, BucketInfo)
cmpSizeAscending
cmpGradientAscending :: Compare (Bucket, BucketInfo)
cmpGradientAscending = ((Bucket, BucketInfo) -> Maybe Double)
-> Compare (Bucket, BucketInfo)
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (((Double, Double, Double) -> Double)
-> Maybe (Double, Double, Double) -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double, Double, Double) -> Double
forall a b c. (a, b, c) -> b
getGradient (Maybe (Double, Double, Double) -> Maybe Double)
-> ((Bucket, BucketInfo) -> Maybe (Double, Double, Double))
-> (Bucket, BucketInfo)
-> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BucketInfo -> Maybe (Double, Double, Double)
bucketGradient (BucketInfo -> Maybe (Double, Double, Double))
-> ((Bucket, BucketInfo) -> BucketInfo)
-> (Bucket, BucketInfo)
-> Maybe (Double, Double, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bucket, BucketInfo) -> BucketInfo
forall a b. (a, b) -> b
snd)
 where
   getGradient :: (a, b, c) -> b
getGradient (a
_a, b
b, c
_r2) = b
b
cmpGradientDescending :: Compare (Bucket, BucketInfo)
cmpGradientDescending = Compare (Bucket, BucketInfo) -> Compare (Bucket, BucketInfo)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Compare (Bucket, BucketInfo)
cmpGradientAscending

prune :: Int
      -> Args
      -> Map Bucket BucketInfo
      -> Map Bucket (Int, BucketInfo)
prune :: Int
-> Args -> Map Bucket BucketInfo -> Map Bucket (Int, BucketInfo)
prune Int
limit Args
args Map Bucket BucketInfo
ts =
  let ccTotals :: [(Bucket, BucketInfo)]
ccTotals = Compare (Bucket, BucketInfo)
-> [(Bucket, BucketInfo)] -> [(Bucket, BucketInfo)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Compare (Bucket, BucketInfo)
cmpSizeDescending
                  (Map Bucket BucketInfo -> [(Bucket, BucketInfo)]
forall k a. Map k a -> [(k, a)]
toList Map Bucket BucketInfo
ts)
      bands :: [(Bucket, BucketInfo)]
bands = Int -> [(Bucket, BucketInfo)] -> [(Bucket, BucketInfo)]
forall a. Int -> [a] -> [a]
take Int
limit [(Bucket, BucketInfo)]
ccTotals
      ccs :: [Bucket]
ccs = ((Bucket, BucketInfo) -> Bucket)
-> [(Bucket, BucketInfo)] -> [Bucket]
forall a b. (a -> b) -> [a] -> [b]
map (Bucket, BucketInfo) -> Bucket
forall a b. (a, b) -> a
fst (Compare (Bucket, BucketInfo)
-> [(Bucket, BucketInfo)] -> [(Bucket, BucketInfo)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Args -> Compare (Bucket, BucketInfo)
getComparison Args
args) [(Bucket, BucketInfo)]
bands)
      res :: [(Bucket, (Int, BucketInfo))]
      res :: [(Bucket, (Int, BucketInfo))]
res = (Bucket -> Int -> (Bucket, (Int, BucketInfo)))
-> [Bucket] -> [Int] -> [(Bucket, (Int, BucketInfo))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Bucket
b Int
k -> (Bucket
b, (Int
k, Map Bucket BucketInfo
ts Map Bucket BucketInfo -> Bucket -> BucketInfo
forall k a. Ord k => Map k a -> k -> a
! Bucket
b))) ([Bucket] -> [Bucket]
forall a. [a] -> [a]
reverse [Bucket]
ccs) [Int
1..]
  in  [(Bucket, (Int, BucketInfo))] -> Map Bucket (Int, BucketInfo)
forall k a. Ord k => [(k, a)] -> Map k a
fromList [(Bucket, (Int, BucketInfo))]
res

pruneBands, pruneDetailed :: Args -> Map Bucket BucketInfo -> Map Bucket (Int, BucketInfo)
pruneBands :: Args -> Map Bucket BucketInfo -> Map Bucket (Int, BucketInfo)
pruneBands Args
as = Int
-> Args -> Map Bucket BucketInfo -> Map Bucket (Int, BucketInfo)
prune (Int -> Int
bound (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Args -> Int
nBands Args
as) Args
as
pruneDetailed :: Args -> Map Bucket BucketInfo -> Map Bucket (Int, BucketInfo)
pruneDetailed Args
as = Int
-> Args -> Map Bucket BucketInfo -> Map Bucket (Int, BucketInfo)
prune (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
forall a. Bounded a => a
maxBound (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Args -> Maybe Int
detailedLimit Args
as) Args
as


bound :: Int -> Int
bound :: Int -> Int
bound Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Int
forall a. Bounded a => a
maxBound
  | Bool
otherwise = Int
n