-- |
-- Module      :  TwoQuantizer
-- Copyright   :  (c) OleksandrZhabenko 2022-2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- A module to provide the simple version of the obtaining from the list of values the list of other
-- values, the pre-defined ones. Provides both pure functions and monadic versions.

{-# 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 -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. 
  -> Double 
  -> Double 
  -> Double 
  -> Maybe Double -- ^ The numeric value (in 'Just' case) can be equal just to the one of the two first arguments.
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  -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. 
 -> [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  -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. 
 -> [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 -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. 
 -> (a -> a -> a -> Ordering) 
 -> a 
 -> a 
 -> a 
 -> Maybe a -- ^ The @a@ value (in 'Just' case) can be equal just to the one of the two first @a@ arguments.
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 -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. 
 -> (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, Integral a) => Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. 
 -> (a -> a -> a -> Ordering) 
 -> [a] 
 -> [a] 
 -> [a]
twoQuantizerG :: forall a.
(Ord a, Floating a, Integral 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, Integral a) => [a] -> a -> a -> a
meanF2 [a]
needs a
0 a
0 forall a. Fractional a => a -> a -> a
/ forall a. (Floating a, Integral 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 -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. 
 -> (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 -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. 
 -> (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, Integral a) => [a] 
 -> a 
 -> a 
 -> a
meanF2 :: forall a. (Floating a, Integral a) => [a] -> a -> a -> a
meanF2 (a
t:[a]
ts) a
s a
l = forall a. (Floating a, Integral 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
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
l

twoQuantizerGM 
 :: (Ord a, Floating a, Integral a, Monad m) => Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. 
 -> (a -> a -> a -> m Ordering) 
 -> [a] 
 -> [a] 
 -> m [a]
twoQuantizerGM :: forall a (m :: * -> *).
(Ord a, Floating a, Integral 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, Integral a) => [a] -> a -> a -> a
meanF2 [a]
needs a
0 a
0  forall a. Fractional a => a -> a -> a
/ forall a. (Floating a, Integral 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