-- |
-- 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. Contrary to
-- ListQuantizer module, the results  in every function  here depend on the two values, 
-- which the point is located in between. Defined for just positive real numbers of 'Double' type.

{-# 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. The ambigous situation is when the square of the third paremeter is equal to  the product of the second one and the fourth one. 
  -> Double 
  -> Double -- ^ This one should lie between the other two similar parameters — the one before and the one after it.
  -> 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 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  -- ^ 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 
 | [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  -- ^ 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 = (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 -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. The ambigous situation is defined by the second argument.
 -> (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 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 -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. The ambigous situation is defined by the second argument.
 -> (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 -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. The ambigous situation is defined by the second argument.
 -> (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 -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. The ambigous situation is defined by the second argument.
 -> (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 -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. The ambigous situation is defined by the second argument.
 -> (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

-- | Simple arithmetic mean. Is vulnerable to floating point rounding error so if possible use just
-- for double-precision values.
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 -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. The ambigous situation is defined by the second argument.
 -> (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