{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TypeApplications #-} 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 import Data.Word (Word64) import Text.Read (readMaybe) import qualified Data.Text as T 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 Number, reversing :: Args -> Bool reversing = Bool True } = Compare (Bucket, BucketInfo) cmpNumberDescending getComparison Args { sorting :: Args -> Sort sorting = Sort Number, reversing :: Args -> Bool reversing = Bool False } = Compare (Bucket, BucketInfo) cmpNumberAscending 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, cmpNumberAscending, cmpNumberDescending, 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 cmpNumberAscending :: Compare (Bucket, BucketInfo) cmpNumberAscending (Bucket Text a, BucketInfo _) (Bucket Text b, BucketInfo _) = (Text -> Maybe Word64) -> Text -> Text -> Ordering forall a b. Ord a => (b -> a) -> b -> b -> Ordering comparing (forall a. Read a => String -> Maybe a readMaybe @Word64 (String -> Maybe Word64) -> (Text -> String) -> Text -> Maybe Word64 forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String T.unpack) Text a Text b Ordering -> Ordering -> Ordering forall a. Semigroup a => a -> a -> a <> Text -> Text -> Ordering forall a. Ord a => a -> a -> Ordering compare Text a Text b cmpNumberDescending :: Compare (Bucket, BucketInfo) cmpNumberDescending = Compare (Bucket, BucketInfo) -> Compare (Bucket, BucketInfo) forall a b c. (a -> b -> c) -> b -> a -> c flip Compare (Bucket, BucketInfo) cmpNumberAscending 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 a b. (a -> b) -> Maybe a -> Maybe b 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