-- | -- 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. {-# 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. -> (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 bool f xs z | z `F.elem` xs = Just z | F.length xs < 2 = Nothing | z < x || z > y = Nothing | F.null ts = Just u | F.null us = Just t | otherwise = Just (case f xs z of { GT -> u; LT -> t; EQ -> if bool then u else t }) where (x, y) = fromJust . minMax11 $ xs (ts,us) = S.span ( Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. -> (t1 a -> a -> Ordering) -> t1 a -> t2 a -> [a] foldableQuantizerG ctrl f needs xs = map (fromJust . round2G ctrl f needs) ys where k = Q.meanF2 (F.toList needs) 0 0 / Q.meanF2 (F.toList xs) 0 0 ys = F.foldr (\t ts -> t * k : ts) [] 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. -> (t1 a -> a -> m Ordering) -> t1 a -> a -> m (Maybe a) round2GM bool f xs z | z `F.elem` xs = return . Just $ z | F.length xs < 2 = return Nothing | z < x || z > y = return Nothing | F.null ts = return u | F.null us = return t | otherwise = do q <- f xs z case q of { GT -> return u; LT -> return t; EQ -> return (if bool then u else t)} where (x, y) = fromJust . minMax11 $ xs (ts,us) = S.span ( Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. -> (t1 a -> a -> m Ordering) -> t1 a -> t2 a -> m [a] foldableQuantizerGM ctrl f needs xs = mapM (fmap fromJust . round2GM ctrl f needs) ys where k = Q.meanF2 (F.toList needs) 0 0 / Q.meanF2 (F.toList xs) 0 0 ys = F.foldr (\u us -> u * k : us) [] xs