-- |
-- 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 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. 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 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. 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 
 | 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. The ambigous situation is defined by the second argument.
 -> (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. 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 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. 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 
 | 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

-- | Simple arithmetic mean. Is vulnerable to floating point rounding error so if possible use just
-- for double-precision values.
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. 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, 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