{-# 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 forall a. Ord a => a -> a -> Bool
<= Double
0 Bool -> Bool -> Bool
|| Double
y forall a. Ord a => a -> a -> Bool
<= Double
0 Bool -> Bool -> Bool
|| Double
z forall a. Ord a => a -> a -> Bool
<= Double
0 = forall a. Maybe a
Nothing
| (Double
x forall a. Num a => a -> a -> a
- Double
z) forall a. Num a => a -> a -> a
* (Double
y forall a. Num a => a -> a -> a
- Double
z) forall a. Ord a => a -> a -> Bool
<= Double
0 = forall a. a -> Maybe a
Just (case forall a. Ord a => a -> a -> Ordering
compare (Double
zforall a. Num a => a -> a -> a
*Double
z) (Double
xforall a. Num a => a -> a -> a
*Double
y) of { Ordering
GT -> forall a. Ord a => a -> a -> a
max Double
x Double
y; Ordering
LT -> forall a. Ord a => a -> a -> a
min Double
x Double
y; Ordering
EQ -> (if Bool
bool then forall a. Ord a => a -> a -> a
max else forall a. Ord a => a -> a -> a
min) Double
x Double
y })
| Bool
otherwise = forall a. Maybe a
Nothing
round2L
:: Bool
-> [Double]
-> Double
-> Double
round2L :: Bool -> [Double] -> Double -> Double
round2L Bool
ctrl [Double]
ts Double
x
| forall a. [a] -> Bool
null [Double]
ts = Double
x
| forall a. [a] -> Bool
null [Double]
ks = Double
y
| forall a. [a] -> Bool
null [Double]
us = Double
y0
| Double
x forall a. Ord a => a -> a -> Bool
< Double
y = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Double -> Double -> Double -> Maybe Double
round2 Bool
ctrl Double
y0 Double
y forall a b. (a -> b) -> a -> b
$ Double
x
| Bool
otherwise = Double
y
where ([Double]
ks, [Double]
us) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Ord a => a -> a -> Bool
<Double
x) [Double]
ts
y :: Double
y = forall a. [a] -> a
head [Double]
us
y0 :: Double
y0 = forall a. [a] -> a
last [Double]
ks
twoQuantizer
:: Bool
-> [Double]
-> [Double]
-> [Double]
twoQuantizer :: Bool -> [Double] -> [Double] -> [Double]
twoQuantizer Bool
ctrl [Double]
needs [Double]
xs = 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 forall a. Fractional a => a -> a -> a
/ [Double] -> Double
meanD [Double]
xs
ys :: [Double]
ys = forall a b. (a -> b) -> [a] -> [b]
map (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 forall a. Eq a => a -> a -> Bool
== a
x = forall a. a -> Maybe a
Just a
x
| a
z forall a. Eq a => a -> a -> Bool
== a
y = forall a. a -> Maybe a
Just a
y
| (a
x forall a. Ord a => a -> a -> Bool
< a
z Bool -> Bool -> Bool
&& a
y forall a. Ord a => a -> a -> Bool
> a
z) Bool -> Bool -> Bool
|| (a
x forall a. Ord a => a -> a -> Bool
> a
z Bool -> Bool -> Bool
&& a
y forall a. Ord a => a -> a -> Bool
< a
z) = forall a. a -> Maybe a
Just (case a -> a -> a -> Ordering
f a
x a
y a
z of { Ordering
GT -> forall a. Ord a => a -> a -> a
max a
x a
y; Ordering
LT -> forall a. Ord a => a -> a -> a
min a
x a
y; Ordering
EQ -> (if Bool
bool then forall a. Ord a => a -> a -> a
max else forall a. Ord a => a -> a -> a
min) a
x a
y })
| Bool
otherwise = 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
| forall a. [a] -> Bool
null [a]
ts = a
x
| forall a. [a] -> Bool
null [a]
ks = a
y
| forall a. [a] -> Bool
null [a]
us = a
y0
| a
x forall a. Ord a => a -> a -> Bool
< a
y = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$ a
x
| Bool
otherwise = a
y
where ([a]
ks, [a]
us) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Ord a => a -> a -> Bool
<a
x) [a]
ts
y :: a
y = forall a. [a] -> a
head [a]
us
y0 :: a
y0 = forall a. [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 = forall a b. (a -> b) -> [a] -> [b]
map (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 = forall a. Floating a => [a] -> a -> a -> a
meanF2 [a]
needs a
0 a
0 forall a. Fractional a => a -> a -> a
/ forall a. Floating a => [a] -> a -> a -> a
meanF2 [a]
xs a
0 a
0
ys :: [a]
ys = forall a b. (a -> b) -> [a] -> [b]
map (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 forall a. Eq a => a -> a -> Bool
== a
x = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ a
x
| a
z forall a. Eq a => a -> a -> Bool
== a
y = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ a
y
| (a
x forall a. Ord a => a -> a -> Bool
< a
z Bool -> Bool -> Bool
&& a
y forall a. Ord a => a -> a -> Bool
> a
z) Bool -> Bool -> Bool
|| (a
x forall a. Ord a => a -> a -> Bool
> a
z Bool -> Bool -> Bool
&& a
y 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
max a
x forall a b. (a -> b) -> a -> b
$ a
y; Ordering
LT -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
min a
x forall a b. (a -> b) -> a -> b
$ a
y; Ordering
EQ -> forall (m :: * -> *) a. Monad m => a -> m a
returnforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (if Bool
bool then forall a. Ord a => a -> a -> a
max else forall a. Ord a => a -> a -> a
min) a
x a
y }
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return 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
| forall a. [a] -> Bool
null [a]
ts = forall (m :: * -> *) a. Monad m => a -> m a
return a
x
| forall a. [a] -> Bool
null [a]
ks = forall (m :: * -> *) a. Monad m => a -> m a
return a
y
| forall a. [a] -> Bool
null [a]
us = forall (m :: * -> *) a. Monad m => a -> m a
return a
y0
| a
x forall a. Ord a => a -> a -> Bool
< a
y = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$ a
x
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return a
y
where ([a]
ks, [a]
us) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Ord a => a -> a -> Bool
<a
x) [a]
ts
y :: a
y = forall a. [a] -> a
head [a]
us
y0 :: a
y0 = forall a. [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 = forall a. Floating a => [a] -> a -> a -> a
meanF2 [a]
ts (a
s forall a. Num a => a -> a -> a
+ a
t) (a
l forall a. Num a => a -> a -> a
+ a
1)
meanF2 [a]
_ a
s a
l = a
s 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 = forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (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 = forall a. Floating a => [a] -> a -> a -> a
meanF2 [a]
needs a
0 a
0 forall a. Fractional a => a -> a -> a
/ forall a. Floating a => [a] -> a -> a -> a
meanF2 [a]
xs a
0 a
0
ys :: [a]
ys = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
*a
k) [a]
xs