-- |
-- Module      :  ListQuantizer
-- Copyright   :  (c) OleksandrZhabenko 2023-2024
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- A module to provide the extended variants to convert a list with
-- some values to another one with the values from the pre-defined another list. Similar to 
-- the measurement of the quantum state observables with the discrete spectrum. Contrary to
-- TwoQuantizer module, the results  in every function  here depend not just on the two values, 
-- which the point is located in between, but on the whole list. Defined for just positive real numbers of 'Double' type.


{-# LANGUAGE NoImplicitPrelude #-}

module ListQuantizer where

import GHC.Base
import GHC.List
import GHC.Real
import GHC.Float
import GHC.Num
import Data.Maybe
import qualified TwoQuantizer as Q (meanF2)
import Data.MinMax1 (minMax11)

-- | A better suited variant for 'FoldableQuantizer.round2G' for lists. 
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 -> Ordering) 
 -> [a] 
 -> a 
 -> Maybe a -- ^ The @a@ value (in 'Just' case) can be equal just to the one of the two first @a@ arguments.
round2GL :: forall a.
Ord a =>
Bool -> ([a] -> a -> Ordering) -> [a] -> a -> Maybe a
round2GL Bool
bool [a] -> a -> Ordering
f [a]
xs a
z 
 | a
z a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
`elem` [a]
xs = a -> Maybe a
forall a. a -> Maybe a
Just a
z
 | [a] -> Int
forall a. [a] -> Int
length [a]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = Maybe a
forall a. Maybe a
Nothing
 | a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x Bool -> Bool -> Bool
|| a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y = Maybe a
forall a. Maybe a
Nothing
 | [a] -> Bool
forall a. [a] -> Bool
null [a]
ts = a -> Maybe a
forall a. a -> Maybe a
Just a
u
 | [a] -> Bool
forall a. [a] -> Bool
null [a]
us = a -> Maybe a
forall a. a -> Maybe a
Just a
t
 | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (case [a] -> a -> Ordering
f [a]
xs a
z of { Ordering
GT -> a
u; Ordering
LT -> a
t; Ordering
EQ -> if Bool
bool then a
u else a
t })
     where (a
x, a
y) = Maybe (a, a) -> (a, a)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (a, a) -> (a, a)) -> ([a] -> Maybe (a, a)) -> [a] -> (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (a, a)
forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Maybe (a, a)
minMax11 ([a] -> (a, a)) -> [a] -> (a, a)
forall a b. (a -> b) -> a -> b
$ [a]
xs
           ([a]
ts,[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
z) [a]
xs
           t :: a
t = [a] -> a
forall a. HasCallStack => [a] -> a
last [a]
ts
           u :: a
u = [a] -> a
forall a. HasCallStack => [a] -> a
head [a]
us

foldableQuantizerGL 
 :: (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 -> Ordering) 
 -> [a] 
 -> [a]
 -> [a]
foldableQuantizerGL :: forall a.
(Ord a, Floating a) =>
Bool -> ([a] -> a -> Ordering) -> [a] -> [a] -> [a]
foldableQuantizerGL Bool
ctrl [a] -> a -> Ordering
f [a]
needs [a]
xs = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (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 -> Ordering) -> [a] -> a -> Maybe a
forall a.
Ord a =>
Bool -> ([a] -> a -> Ordering) -> [a] -> a -> Maybe a
round2GL Bool
ctrl [a] -> a -> Ordering
f [a]
needs) [a]
ys
  where k :: a
k = [a] -> a -> a -> a
forall a. Floating a => [a] -> a -> a -> a
Q.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
Q.meanF2 [a]
xs a
0 a
0
        ys :: [a]
ys = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\a
t [a]
ts -> a
t a -> a -> a
forall a. Num a => a -> a -> a
* a
k a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ts) [] [a]
xs

round2GML 
 :: (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 -> m Ordering) 
 -> [a] 
 -> a 
 -> m (Maybe a)
round2GML :: forall a (m :: * -> *).
(Ord a, Monad m) =>
Bool -> ([a] -> a -> m Ordering) -> [a] -> a -> m (Maybe a)
round2GML Bool
bool [a] -> a -> m Ordering
f [a]
xs a
z 
 | a
z a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
`elem` [a]
xs = 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
z
 | [a] -> Int
forall a. [a] -> Int
length [a]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = 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
 | a
z a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x Bool -> Bool -> Bool
|| a
z a -> a -> Bool
forall a. Ord 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
forall a. Maybe a
Nothing
 | [a] -> Bool
forall a. [a] -> Bool
null [a]
ts = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
u
 | [a] -> Bool
forall a. [a] -> Bool
null [a]
us = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
t
 | Bool
otherwise = do
     Ordering
q <- [a] -> a -> m Ordering
f [a]
xs a
z
     case Ordering
q of { Ordering
GT -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
u; Ordering
LT -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
t; Ordering
EQ -> Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool
bool then Maybe a
u else Maybe a
t)}
   where (a
x, a
y) = Maybe (a, a) -> (a, a)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (a, a) -> (a, a)) -> ([a] -> Maybe (a, a)) -> [a] -> (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (a, a)
forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Maybe (a, a)
minMax11 ([a] -> (a, a)) -> [a] -> (a, a)
forall a b. (a -> b) -> a -> b
$ [a]
xs
         ([a]
ts,[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
z) [a]
xs
         t :: Maybe a
t = if [a] -> Bool
forall a. [a] -> Bool
null [a]
ts then Maybe a
forall a. Maybe a
Nothing else 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
forall a. HasCallStack => [a] -> a
last ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a]
ts
         u :: Maybe a
u = if [a] -> Bool
forall a. [a] -> Bool
null [a]
us then Maybe a
forall a. Maybe a
Nothing else 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
forall a. HasCallStack => [a] -> a
head ([a] -> Maybe a) -> [a] -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a]
us

foldableQuantizerGML 
 :: (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 -> m Ordering) 
 -> [a] 
 -> [a] 
 -> m [a]
foldableQuantizerGML :: forall a (m :: * -> *).
(Ord a, Floating a, Monad m) =>
Bool -> ([a] -> a -> m Ordering) -> [a] -> [a] -> m [a]
foldableQuantizerGML Bool
ctrl [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 ((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 -> m Ordering) -> [a] -> a -> m (Maybe a)
forall a (m :: * -> *).
(Ord a, Monad m) =>
Bool -> ([a] -> a -> m Ordering) -> [a] -> a -> m (Maybe a)
round2GML Bool
ctrl [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
Q.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
Q.meanF2 [a]
xs a
0 a
0
        ys :: [a]
ys = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (\a
u [a]
us -> a
u a -> a -> a
forall a. Num a => a -> a -> a
* a
k a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
us) [] [a]
xs