{-# 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'
, forall a. Ord a => [a] -> [a]
sort
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {b} {c}. [(Int, (b, c))] -> (Double, b, c)
aggr
forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. (a -> a -> Ordering) -> a -> a -> Bool
eql forall {a} {a} {a}. Ord a => (a, a) -> (a, a) -> Ordering
cmpsnd)
forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall {a} {a} {a}. Ord a => (a, a) -> (a, a) -> Ordering
cmpsnd
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {b}. (a, (a, b)) -> (a, (a, b))
nrml
forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (forall {a} {a} {a}. [a -> a] -> (a, a) -> [a]
apply [x -> String]
asp) [(Int, x)]
xs) [(Int, x)]
xs
)
where n' :: Int
n' = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Int, x)]
xs
n :: Double
n = 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 forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (a, a)
x) 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 = forall a. Ord a => a -> a -> Ordering
compare (forall a b. (a, b) -> b
snd (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 = (forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Int, (b, c))]
axs) 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 = forall x.
Ord x =>
[x -> String] -> [(Int, x)] -> (Int, [(Double, [String], x)])
mkStatisticW [x -> String]
asp (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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" elements")
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {x} {a} {a}.
(Verbose (Percent x), Eq a, Show a, Show a) =>
(x, [a], a) -> IO ()
putLnElm forall a b. (a -> b) -> a -> b
$ [(Double, [String], x)]
sts
where (Int
n,[(Double, [String], x)]
sts) = 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 (forall a. Verbose a => Verbosity -> a -> String
vshow Verbosity
Middle (forall x. x -> Percent x
Percent x
w))
String -> IO ()
putStr String
" "
String -> IO ()
putStr (if [a]
as forall a. Eq a => a -> a -> Bool
== [] then String
"" else (forall a. Show a => a -> String
show [a]
as forall a. [a] -> [a] -> [a]
++ String
" "))
String -> IO ()
putStr String
"-> "
String -> IO ()
putStr (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 = forall x. (Show x, Ord x) => [x -> String] -> [(Int, x)] -> IO ()
putStatisticW [x -> String]
asp (forall a b. (a -> b) -> [a] -> [b]
map (\x
x -> (Int
1,x
x)) [x]
xs)