-- |
-- Module      :  FoldableQuantizer
-- Copyright   :  (c) OleksandrZhabenko 2022-2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- A module to provide the extended variants to convert a 'S.InsertLeft' instance structure with
-- some values to another one with the values from the pre-defined structure. Similar to 
-- the measurement of the quantum state observables with the discrete spectrum.
-- For performance reasons it is better to use module ListQuantizer whenever possible (especially if the
-- given 'F.Foldable' and 'S.InsertLeft' instances are just lists). 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 structure. Defined for just positive real numbers of 'Double' type.

{-# LANGUAGE NoImplicitPrelude #-}

module FoldableQuantizer where

import GHC.Base
import GHC.List
import GHC.Real
import GHC.Float
import GHC.Num
import Data.Maybe
import qualified Data.Foldable as F
import qualified TwoQuantizer as Q (meanF2)
import Data.MinMax (minMax11)
import qualified Data.SubG as S

round2G 
 :: (Ord a, S.InsertLeft t a, Monoid (t 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.
 -> (t a -> a -> Ordering) 
 -> t 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 (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
Bool -> (t a -> a -> Ordering) -> t a -> a -> Maybe a
round2G Bool
bool t a -> a -> Ordering
f t a
xs a
z 
 | a
z forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`F.elem` t a
xs = forall a. a -> Maybe a
Just a
z
 | forall (t :: * -> *) a. Foldable t => t a -> Int
F.length t a
xs forall a. Ord a => a -> a -> Bool
< Int
2 = forall a. Maybe a
Nothing
 | a
z forall a. Ord a => a -> a -> Bool
< a
x Bool -> Bool -> Bool
|| a
z forall a. Ord a => a -> a -> Bool
> a
y = forall a. Maybe a
Nothing
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t a
ts = forall a. a -> Maybe a
Just a
u
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t a
us = forall a. a -> Maybe a
Just a
t
 | Bool
otherwise = forall a. a -> Maybe a
Just (case t a -> a -> Ordering
f t 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) = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
t a -> Maybe (a, a)
minMax11 forall a b. (a -> b) -> a -> b
$ t a
xs
         (t a
ts,t a
us) = forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a)) =>
(a -> Bool) -> t a -> (t a, t a)
S.span (forall a. Ord a => a -> a -> Bool
<a
z) t a
xs
         t :: a
t = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a)) =>
t a -> Maybe a
S.safeLastG forall a b. (a -> b) -> a -> b
$ t a
ts -- This can cause some perfarmance downgrade because of the general implementation being not optimized.
         u :: a
u = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Maybe a
S.safeHeadG forall a b. (a -> b) -> a -> b
$ t a
us

foldableQuantizerG 
 :: (Ord a, Floating a, Integral a, S.InsertLeft t1 a, Monoid (t1 a), F.Foldable t2) => 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.
 -> (t1 a -> a -> Ordering) 
 -> t1 a 
 -> t2 a
 -> [a]
foldableQuantizerG :: forall a (t1 :: * -> *) (t2 :: * -> *).
(Ord a, Floating a, Integral a, InsertLeft t1 a, Monoid (t1 a),
 Foldable t2) =>
Bool -> (t1 a -> a -> Ordering) -> t1 a -> t2 a -> [a]
foldableQuantizerG Bool
ctrl t1 a -> a -> Ordering
f t1 a
needs t2 a
xs = forall a b. (a -> b) -> [a] -> [b]
map (forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
Bool -> (t a -> a -> Ordering) -> t a -> a -> Maybe a
round2G Bool
ctrl t1 a -> a -> Ordering
f t1 a
needs) [a]
ys
  where k :: a
k = forall a. (Floating a, Integral a) => [a] -> a -> a -> a
Q.meanF2 (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t1 a
needs) a
0 a
0 forall a. Fractional a => a -> a -> a
/ forall a. (Floating a, Integral a) => [a] -> a -> a -> a
Q.meanF2 (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t2 a
xs) a
0 a
0
        ys :: [a]
ys = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr (\a
t [a]
ts -> a
t forall a. Num a => a -> a -> a
* a
k forall a. a -> [a] -> [a]
: [a]
ts) [] t2 a
xs

round2GM 
 :: (Ord a, Monad m, S.InsertLeft t1 a, Monoid (t1 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.
 -> (t1 a -> a -> m Ordering) 
 -> t1 a 
 -> a 
 -> m (Maybe a)
round2GM :: forall a (m :: * -> *) (t1 :: * -> *).
(Ord a, Monad m, InsertLeft t1 a, Monoid (t1 a)) =>
Bool -> (t1 a -> a -> m Ordering) -> t1 a -> a -> m (Maybe a)
round2GM Bool
bool t1 a -> a -> m Ordering
f t1 a
xs a
z 
 | a
z forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`F.elem` t1 a
xs = 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
z
 | forall (t :: * -> *) a. Foldable t => t a -> Int
F.length t1 a
xs forall a. Ord a => a -> a -> Bool
< Int
2 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
 | a
z forall a. Ord a => a -> a -> Bool
< a
x Bool -> Bool -> Bool
|| a
z forall a. Ord a => a -> a -> Bool
> a
y = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t1 a
ts = forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
u
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t1 a
us = forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
t
 | Bool
otherwise = do
     Ordering
q <- t1 a -> a -> m Ordering
f t1 a
xs a
z
     case Ordering
q of { Ordering
GT -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
u; Ordering
LT -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
t; Ordering
EQ -> 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) = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
t a -> Maybe (a, a)
minMax11 forall a b. (a -> b) -> a -> b
$ t1 a
xs
         (t1 a
ts,t1 a
us) = forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a)) =>
(a -> Bool) -> t a -> (t a, t a)
S.span (forall a. Ord a => a -> a -> Bool
<a
z) t1 a
xs
         t :: Maybe a
t = forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a)) =>
t a -> Maybe a
S.safeLastG t1 a
ts --  This can cause some perfarmance downgrade because of the general implementation being not optimized.
         u :: Maybe a
u = forall (t :: * -> *) a. Foldable t => t a -> Maybe a
S.safeHeadG t1 a
us

foldableQuantizerGM 
 :: (Ord a, Floating a, Integral a, Monad m, S.InsertLeft t1 a, Monoid (t1 a), F.Foldable t2) => 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.
 -> (t1 a -> a -> m Ordering) 
 -> t1 a 
 -> t2 a 
 -> m [a]
foldableQuantizerGM :: forall a (m :: * -> *) (t1 :: * -> *) (t2 :: * -> *).
(Ord a, Floating a, Integral a, Monad m, InsertLeft t1 a,
 Monoid (t1 a), Foldable t2) =>
Bool -> (t1 a -> a -> m Ordering) -> t1 a -> t2 a -> m [a]
foldableQuantizerGM Bool
ctrl t1 a -> a -> m Ordering
f t1 a
needs t2 a
xs = forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (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 :: * -> *) (t1 :: * -> *).
(Ord a, Monad m, InsertLeft t1 a, Monoid (t1 a)) =>
Bool -> (t1 a -> a -> m Ordering) -> t1 a -> a -> m (Maybe a)
round2GM Bool
ctrl t1 a -> a -> m Ordering
f t1 a
needs) [a]
ys
  where k :: a
k = forall a. (Floating a, Integral a) => [a] -> a -> a -> a
Q.meanF2 (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t1 a
needs) a
0 a
0  forall a. Fractional a => a -> a -> a
/ forall a. (Floating a, Integral a) => [a] -> a -> a -> a
Q.meanF2 (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t2 a
xs) a
0 a
0
        ys :: [a]
ys = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr (\a
u [a]
us -> a
u forall a. Num a => a -> a -> a
* a
k forall a. a -> [a] -> [a]
: [a]
us) [] t2 a
xs