{-# LANGUAGE FlexibleContexts #-}
module OAlg.Data.Statistics
(
mkStatisticW, mkStatistic, putStatisticW, putStatistic
)
where
import Prelude hiding (lookup)
import Data.List (sort, sortBy, groupBy)
import OAlg.Control.Verbose
import OAlg.Data.Equal
mkStatisticW :: Ord x => [x -> String] -> [(Int,x)] -> (Int,[(Double,[String],x)])
mkStatisticW :: forall x.
Ord x =>
[x -> String] -> [(Int, x)] -> (Int, [(Double, [String], x)])
mkStatisticW [x -> String]
asp [(Int, x)]
xs = ( Int
n'
, [(Double, [String], x)] -> [(Double, [String], x)]
forall a. Ord a => [a] -> [a]
sort
([(Double, [String], x)] -> [(Double, [String], x)])
-> [(Double, [String], x)] -> [(Double, [String], x)]
forall a b. (a -> b) -> a -> b
$ ([(Int, ([String], x))] -> (Double, [String], x))
-> [[(Int, ([String], x))]] -> [(Double, [String], x)]
forall a b. (a -> b) -> [a] -> [b]
map [(Int, ([String], x))] -> (Double, [String], x)
forall {b} {c}. [(Int, (b, c))] -> (Double, b, c)
aggr
([[(Int, ([String], x))]] -> [(Double, [String], x)])
-> [[(Int, ([String], x))]] -> [(Double, [String], x)]
forall a b. (a -> b) -> a -> b
$ ((Int, ([String], x)) -> (Int, ([String], x)) -> Bool)
-> [(Int, ([String], x))] -> [[(Int, ([String], x))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (((Int, ([String], x)) -> (Int, ([String], x)) -> Ordering)
-> (Int, ([String], x)) -> (Int, ([String], x)) -> Bool
forall a. (a -> a -> Ordering) -> a -> a -> Bool
eql (Int, ([String], x)) -> (Int, ([String], x)) -> Ordering
forall {a} {a} {a}. Ord a => (a, a) -> (a, a) -> Ordering
cmpsnd)
([(Int, ([String], x))] -> [[(Int, ([String], x))]])
-> [(Int, ([String], x))] -> [[(Int, ([String], x))]]
forall a b. (a -> b) -> a -> b
$ ((Int, ([String], x)) -> (Int, ([String], x)) -> Ordering)
-> [(Int, ([String], x))] -> [(Int, ([String], x))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Int, ([String], x)) -> (Int, ([String], x)) -> Ordering
forall {a} {a} {a}. Ord a => (a, a) -> (a, a) -> Ordering
cmpsnd
([(Int, ([String], x))] -> [(Int, ([String], x))])
-> [(Int, ([String], x))] -> [(Int, ([String], x))]
forall a b. (a -> b) -> a -> b
$ (([String], (Int, x)) -> (Int, ([String], x)))
-> [([String], (Int, x))] -> [(Int, ([String], x))]
forall a b. (a -> b) -> [a] -> [b]
map ([String], (Int, x)) -> (Int, ([String], x))
forall {a} {a} {b}. (a, (a, b)) -> (a, (a, b))
nrml
([([String], (Int, x))] -> [(Int, ([String], x))])
-> [([String], (Int, x))] -> [(Int, ([String], x))]
forall a b. (a -> b) -> a -> b
$ [[String]] -> [(Int, x)] -> [([String], (Int, x))]
forall a b. [a] -> [b] -> [(a, b)]
zip (((Int, x) -> [String]) -> [(Int, x)] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ([x -> String] -> (Int, x) -> [String]
forall {a} {a} {a}. [a -> a] -> (a, a) -> [a]
apply [x -> String]
asp) [(Int, x)]
xs) [(Int, x)]
xs
)
where n' :: Int
n' = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, x) -> Int) -> [(Int, x)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, x) -> Int
forall a b. (a, b) -> a
fst [(Int, x)]
xs
n :: Double
n = Int -> Double
forall a. Enum a => Int -> a
toEnum Int
n'
apply :: [a -> a] -> (a, a) -> [a]
apply [] (a, a)
_ = []
apply (a -> a
a:[a -> a]
as) (a, a)
x = (a -> a
a (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ (a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
x) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a -> a] -> (a, a) -> [a]
apply [a -> a]
as (a, a)
x
nrml :: (a, (a, b)) -> (a, (a, b))
nrml (a
asp',(a
n'',b
x)) = (a
n'',(a
asp',b
x))
cmpsnd :: (a, a) -> (a, a) -> Ordering
cmpsnd (a, a)
a (a, a)
b = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
a) ((a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
b)
aggr :: [(Int, (b, c))] -> (Double, b, c)
aggr axs :: [(Int, (b, c))]
axs@((Int
_,(b
a,c
x)):[(Int, (b, c))]
_) = (Double
w,b
a,c
x)
where w :: Double
w = (Int -> Double
forall a. Enum a => Int -> a
toEnum (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, (b, c)) -> Int) -> [(Int, (b, c))] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, (b, c)) -> Int
forall a b. (a, b) -> a
fst [(Int, (b, c))]
axs) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
n
mkStatistic :: Ord x => [x -> String] -> [x] -> (Int,[(Double,[String],x)])
mkStatistic :: forall x.
Ord x =>
[x -> String] -> [x] -> (Int, [(Double, [String], x)])
mkStatistic [x -> String]
asp [x]
xs = [x -> String] -> [(Int, x)] -> (Int, [(Double, [String], x)])
forall x.
Ord x =>
[x -> String] -> [(Int, x)] -> (Int, [(Double, [String], x)])
mkStatisticW [x -> String]
asp ((x -> (Int, x)) -> [x] -> [(Int, x)]
forall a b. (a -> b) -> [a] -> [b]
map (\x
x -> (Int
1,x
x)) [x]
xs)
putStatisticW :: (Show x, Ord x) => [x -> String] -> [(Int,x)] -> IO ()
putStatisticW :: forall x. (Show x, Ord x) => [x -> String] -> [(Int, x)] -> IO ()
putStatisticW [x -> String]
asps [(Int, x)]
xs = do
String -> IO ()
putStrLn (String
"statistic of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" elements")
[IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([IO ()] -> IO ()) -> [IO ()] -> IO ()
forall a b. (a -> b) -> a -> b
$ ((Double, [String], x) -> IO ())
-> [(Double, [String], x)] -> [IO ()]
forall a b. (a -> b) -> [a] -> [b]
map (Double, [String], x) -> IO ()
forall {x} {a} {a}.
(Verbose (Percent x), Eq a, Show a, Show a, Show x) =>
(x, [a], a) -> IO ()
putLnElm ([(Double, [String], x)] -> [IO ()])
-> [(Double, [String], x)] -> [IO ()]
forall a b. (a -> b) -> a -> b
$ [(Double, [String], x)]
sts
where (Int
n,[(Double, [String], x)]
sts) = [x -> String] -> [(Int, x)] -> (Int, [(Double, [String], x)])
forall x.
Ord x =>
[x -> String] -> [(Int, x)] -> (Int, [(Double, [String], x)])
mkStatisticW [x -> String]
asps [(Int, x)]
xs
putLnElm :: (x, [a], a) -> IO ()
putLnElm (x
w,[a]
as,a
x) = do
String -> IO ()
putStr (Verbosity -> Percent x -> String
forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
Middle (x -> Percent x
forall x. x -> Percent x
Percent x
w))
String -> IO ()
putStr String
" "
String -> IO ()
putStr (if [a]
as [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [] then String
"" else ([a] -> String
forall a. Show a => a -> String
show [a]
as String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "))
String -> IO ()
putStr String
"-> "
String -> IO ()
putStr (a -> String
forall a. Show a => a -> String
show a
x)
String -> IO ()
putStr String
"\n"
putStatistic :: (Show x, Ord x) => [x -> String] -> [x] -> IO ()
putStatistic :: forall x. (Show x, Ord x) => [x -> String] -> [x] -> IO ()
putStatistic [x -> String]
asp [x]
xs = [x -> String] -> [(Int, x)] -> IO ()
forall x. (Show x, Ord x) => [x -> String] -> [(Int, x)] -> IO ()
putStatisticW [x -> String]
asp ((x -> (Int, x)) -> [x] -> [(Int, x)]
forall a b. (a -> b) -> [a] -> [b]
map (\x
x -> (Int
1,x
x)) [x]
xs)