{-# LANGUAGE NoImplicitPrelude #-}
module TwoQuantizer where
import GHC.Base
import GHC.Num
import Data.Maybe
import Numeric.Stats (meanD)
import GHC.Float
import GHC.Real
import GHC.List
round2
:: Bool
-> Double
-> Double
-> Double
-> Maybe Double
round2 :: Bool -> Double -> Double -> Double -> Maybe Double
round2 Bool
bool Double
x Double
y Double
z
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0 Bool -> Bool -> Bool
|| Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0 Bool -> Bool -> Bool
|| Double
z Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0 = Maybe Double
forall a. Maybe a
Nothing
| (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
z) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
z) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0 = Double -> Maybe Double
forall a. a -> Maybe a
Just (case Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Double
zDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
z) (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
y) of { Ordering
GT -> Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
x Double
y; Ordering
LT -> Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
x Double
y; Ordering
EQ -> (if Bool
bool then Double -> Double -> Double
forall a. Ord a => a -> a -> a
max else Double -> Double -> Double
forall a. Ord a => a -> a -> a
min) Double
x Double
y })
| Bool
otherwise = Maybe Double
forall a. Maybe a
Nothing
round2L
:: Bool
-> [Double]
-> Double
-> Double
round2L :: Bool -> [Double] -> Double -> Double
round2L Bool
ctrl [Double]
ts Double
x
| [Double] -> Bool
forall a. [a] -> Bool
null [Double]
ts = Double
x
| [Double] -> Bool
forall a. [a] -> Bool
null [Double]
ks = Double
y
| [Double] -> Bool
forall a. [a] -> Bool
null [Double]
us = Double
y0
| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
y = Maybe Double -> Double
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Double -> Double)
-> (Double -> Maybe Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Double -> Double -> Double -> Maybe Double
round2 Bool
ctrl Double
y0 Double
y (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
x
| Bool
otherwise = Double
y
where ([Double]
ks, [Double]
us) = (Double -> Bool) -> [Double] -> ([Double], [Double])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<Double
x) [Double]
ts
y :: Double
y = [Double] -> Double
forall a. HasCallStack => [a] -> a
head [Double]
us
y0 :: Double
y0 = [Double] -> Double
forall a. HasCallStack => [a] -> a
last [Double]
ks
twoQuantizer
:: Bool
-> [Double]
-> [Double]
-> [Double]
twoQuantizer :: Bool -> [Double] -> [Double] -> [Double]
twoQuantizer Bool
ctrl [Double]
needs [Double]
xs = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> [Double] -> Double -> Double
round2L Bool
ctrl [Double]
needs) [Double]
ys
where k :: Double
k = [Double] -> Double
meanD [Double]
needs Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ [Double] -> Double
meanD [Double]
xs
ys :: [Double]
ys = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
k) [Double]
xs
round2G
:: (Ord a) => Bool
-> (a -> a -> a -> Ordering)
-> a
-> a
-> a
-> Maybe a
round2G :: forall a.
Ord a =>
Bool -> (a -> a -> a -> Ordering) -> a -> a -> a -> Maybe a
round2G Bool
bool a -> a -> a -> Ordering
f a
x a
y a
z
| a
z a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x = a -> Maybe a
forall a. a -> Maybe a
Just a
x
| a
z a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = a -> Maybe a
forall a. a -> Maybe a
Just a
y
| (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
z Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
z) Bool -> Bool -> Bool
|| (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
z Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
z) = a -> Maybe a
forall a. a -> Maybe a
Just (case a -> a -> a -> Ordering
f a
x a
y a
z of { Ordering
GT -> a -> a -> a
forall a. Ord a => a -> a -> a
max a
x a
y; Ordering
LT -> a -> a -> a
forall a. Ord a => a -> a -> a
min a
x a
y; Ordering
EQ -> (if Bool
bool then a -> a -> a
forall a. Ord a => a -> a -> a
max else a -> a -> a
forall a. Ord a => a -> a -> a
min) a
x a
y })
| Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
round2GL
:: (Ord a) => Bool
-> (a -> a -> a -> Ordering)
-> [a]
-> a
-> a
round2GL :: forall a.
Ord a =>
Bool -> (a -> a -> a -> Ordering) -> [a] -> a -> a
round2GL Bool
ctrl a -> a -> a -> Ordering
f [a]
ts a
x
| [a] -> Bool
forall a. [a] -> Bool
null [a]
ts = a
x
| [a] -> Bool
forall a. [a] -> Bool
null [a]
ks = a
y
| [a] -> Bool
forall a. [a] -> Bool
null [a]
us = a
y0
| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (a -> Maybe a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> (a -> a -> a -> Ordering) -> a -> a -> a -> Maybe a
forall a.
Ord a =>
Bool -> (a -> a -> a -> Ordering) -> a -> a -> a -> Maybe a
round2G Bool
ctrl a -> a -> a -> Ordering
f a
y0 a
y (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
x
| Bool
otherwise = a
y
where ([a]
ks, [a]
us) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
x) [a]
ts
y :: a
y = [a] -> a
forall a. HasCallStack => [a] -> a
head [a]
us
y0 :: a
y0 = [a] -> a
forall a. HasCallStack => [a] -> a
last [a]
ks
twoQuantizerG
:: (Ord a, Floating a) => Bool
-> (a -> a -> a -> Ordering)
-> [a]
-> [a]
-> [a]
twoQuantizerG :: forall a.
(Ord a, Floating a) =>
Bool -> (a -> a -> a -> Ordering) -> [a] -> [a] -> [a]
twoQuantizerG Bool
ctrl a -> a -> a -> Ordering
f [a]
needs [a]
xs = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> (a -> a -> a -> Ordering) -> [a] -> a -> a
forall a.
Ord a =>
Bool -> (a -> a -> a -> Ordering) -> [a] -> a -> a
round2GL Bool
ctrl a -> a -> a -> Ordering
f [a]
needs) [a]
ys
where k :: a
k = [a] -> a -> a -> a
forall a. Floating a => [a] -> a -> a -> a
meanF2 [a]
needs a
0 a
0 a -> a -> a
forall a. Fractional a => a -> a -> a
/ [a] -> a -> a -> a
forall a. Floating a => [a] -> a -> a -> a
meanF2 [a]
xs a
0 a
0
ys :: [a]
ys = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Num a => a -> a -> a
*a
k) [a]
xs
round2GM
:: (Ord a, Monad m) => Bool
-> (a -> a -> a -> m Ordering)
-> a
-> a
-> a
-> m (Maybe a)
round2GM :: forall a (m :: * -> *).
(Ord a, Monad m) =>
Bool -> (a -> a -> a -> m Ordering) -> a -> a -> a -> m (Maybe a)
round2GM Bool
bool a -> a -> a -> m Ordering
f a
x a
y a
z
| a
z a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> (a -> Maybe a) -> a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just (a -> m (Maybe a)) -> a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a
x
| a
z a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> (a -> Maybe a) -> a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just (a -> m (Maybe a)) -> a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a
y
| (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
z Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
z) Bool -> Bool -> Bool
|| (a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
z Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
z) = do
Ordering
t <- a -> a -> a -> m Ordering
f a
x a
y a
z
case Ordering
t of { Ordering
GT -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> (a -> Maybe a) -> a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. Ord a => a -> a -> a
max a
x (a -> m (Maybe a)) -> a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a
y; Ordering
LT -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> (a -> Maybe a) -> a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (a -> a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. Ord a => a -> a -> a
min a
x (a -> m (Maybe a)) -> a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a
y; Ordering
EQ -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return(Maybe a -> m (Maybe a)) -> (a -> Maybe a) -> a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just (a -> m (Maybe a)) -> a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ (if Bool
bool then a -> a -> a
forall a. Ord a => a -> a -> a
max else a -> a -> a
forall a. Ord a => a -> a -> a
min) a
x a
y }
| Bool
otherwise = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
round2GLM
:: (Ord a, Monad m) => Bool
-> (a -> a -> a -> m Ordering)
-> [a]
-> a
-> m a
round2GLM :: forall a (m :: * -> *).
(Ord a, Monad m) =>
Bool -> (a -> a -> a -> m Ordering) -> [a] -> a -> m a
round2GLM Bool
ctrl a -> a -> a -> m Ordering
f [a]
ts a
x
| [a] -> Bool
forall a. [a] -> Bool
null [a]
ts = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
| [a] -> Bool
forall a. [a] -> Bool
null [a]
ks = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
y
| [a] -> Bool
forall a. [a] -> Bool
null [a]
us = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
y0
| a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y = (Maybe a -> a) -> m (Maybe a) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (m (Maybe a) -> m a) -> (a -> m (Maybe a)) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> (a -> a -> a -> m Ordering) -> a -> a -> a -> m (Maybe a)
forall a (m :: * -> *).
(Ord a, Monad m) =>
Bool -> (a -> a -> a -> m Ordering) -> a -> a -> a -> m (Maybe a)
round2GM Bool
ctrl a -> a -> a -> m Ordering
f a
y0 a
y (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ a
x
| Bool
otherwise = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
y
where ([a]
ks, [a]
us) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
x) [a]
ts
y :: a
y = [a] -> a
forall a. HasCallStack => [a] -> a
head [a]
us
y0 :: a
y0 = [a] -> a
forall a. HasCallStack => [a] -> a
last [a]
ks
meanF2
:: (Floating a) => [a]
-> a
-> a
-> a
meanF2 :: forall a. Floating a => [a] -> a -> a -> a
meanF2 (a
t:[a]
ts) a
s a
l = [a] -> a -> a -> a
forall a. Floating a => [a] -> a -> a -> a
meanF2 [a]
ts (a
s a -> a -> a
forall a. Num a => a -> a -> a
+ a
t) (a
l a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)
meanF2 [a]
_ a
s a
l = a
s a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
l
twoQuantizerGM
:: (Ord a, Floating a, Monad m) => Bool
-> (a -> a -> a -> m Ordering)
-> [a]
-> [a]
-> m [a]
twoQuantizerGM :: forall a (m :: * -> *).
(Ord a, Floating a, Monad m) =>
Bool -> (a -> a -> a -> m Ordering) -> [a] -> [a] -> m [a]
twoQuantizerGM Bool
ctrl a -> a -> a -> m Ordering
f [a]
needs [a]
xs = (a -> m a) -> [a] -> m [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Bool -> (a -> a -> a -> m Ordering) -> [a] -> a -> m a
forall a (m :: * -> *).
(Ord a, Monad m) =>
Bool -> (a -> a -> a -> m Ordering) -> [a] -> a -> m a
round2GLM Bool
ctrl a -> a -> a -> m Ordering
f [a]
needs) [a]
ys
where k :: a
k = [a] -> a -> a -> a
forall a. Floating a => [a] -> a -> a -> a
meanF2 [a]
needs a
0 a
0 a -> a -> a
forall a. Fractional a => a -> a -> a
/ [a] -> a -> a -> a
forall a. Floating a => [a] -> a -> a -> a
meanF2 [a]
xs a
0 a
0
ys :: [a]
ys = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Num a => a -> a -> a
*a
k) [a]
xs