{-# 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 = forall a b. Ord a => (b -> a) -> b -> b -> Ordering comparing forall a b. (a, b) -> a fst cmpNameDescending :: Compare (Bucket, BucketInfo) cmpNameDescending = forall a b c. (a -> b -> c) -> b -> a -> c flip Compare (Bucket, BucketInfo) cmpNameAscending cmpStdDevAscending :: Compare (Bucket, BucketInfo) cmpStdDevAscending = forall a b. Ord a => (b -> a) -> b -> b -> Ordering comparing (BucketInfo -> Double bucketStddev forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a, b) -> b snd) cmpStdDevDescending :: Compare (Bucket, BucketInfo) cmpStdDevDescending = forall a b c. (a -> b -> c) -> b -> a -> c flip Compare (Bucket, BucketInfo) cmpStdDevAscending cmpSizeAscending :: Compare (Bucket, BucketInfo) cmpSizeAscending = forall a b. Ord a => (b -> a) -> b -> b -> Ordering comparing (BucketInfo -> Double bucketTotal forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a, b) -> b snd) cmpSizeDescending :: Compare (Bucket, BucketInfo) cmpSizeDescending = forall a b c. (a -> b -> c) -> b -> a -> c flip Compare (Bucket, BucketInfo) cmpSizeAscending cmpGradientAscending :: Compare (Bucket, BucketInfo) cmpGradientAscending = forall a b. Ord a => (b -> a) -> b -> b -> Ordering comparing (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall {a} {b} {c}. (a, b, c) -> b getGradient forall b c a. (b -> c) -> (a -> b) -> a -> c . BucketInfo -> Maybe (Double, Double, Double) bucketGradient forall b c a. (b -> c) -> (a -> b) -> a -> c . 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 = 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 = forall a. (a -> a -> Ordering) -> [a] -> [a] sortBy Compare (Bucket, BucketInfo) cmpSizeDescending (forall k a. Map k a -> [(k, a)] toList Map Bucket BucketInfo ts) bands :: [(Bucket, BucketInfo)] bands = forall a. Int -> [a] -> [a] take Int limit [(Bucket, BucketInfo)] ccTotals ccs :: [Bucket] ccs = forall a b. (a -> b) -> [a] -> [b] map forall a b. (a, b) -> a fst (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 = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith (\Bucket b Int k -> (Bucket b, (Int k, Map Bucket BucketInfo ts forall k a. Ord k => Map k a -> k -> a ! Bucket b))) (forall a. [a] -> [a] reverse [Bucket] ccs) [Int 1..] in 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 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 (forall a. a -> Maybe a -> a fromMaybe forall a. Bounded a => a maxBound 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 forall a. Ord a => a -> a -> Bool <= Int 0 = forall a. Bounded a => a maxBound | Bool otherwise = Int n