{-# 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.MinMax1 (minMax11)
import qualified Data.InsertLeft as IL
round2G
:: (Ord a, IL.InsertLeft t a, Monoid (t a)) => Bool
-> (t a -> a -> Ordering)
-> t a
-> a
-> Maybe a
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 a -> t a -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`F.elem` t a
xs = a -> Maybe a
forall a. a -> Maybe a
Just a
z
| t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length t 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
| t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t a
ts = a -> Maybe a
forall a. a -> Maybe a
Just a
u
| t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t 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 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) = Maybe (a, a) -> (a, a)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (a, a) -> (a, a)) -> (t a -> Maybe (a, a)) -> t a -> (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Maybe (a, a)
forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Maybe (a, a)
minMax11 (t a -> (a, a)) -> t a -> (a, a)
forall a b. (a -> b) -> a -> b
$ t a
xs
(t a
ts,t a
us) = (a -> Bool) -> t a -> (t a, t a)
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a)) =>
(a -> Bool) -> t a -> (t a, t a)
IL.span (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
z) t a
xs
t :: a
t = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (t a -> Maybe a) -> t a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Maybe a
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a)) =>
t a -> Maybe a
IL.safeLastG (t a -> a) -> t a -> a
forall a b. (a -> b) -> a -> b
$ t a
ts
u :: a
u = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (t a -> Maybe a) -> t a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t a -> Maybe a
forall (t :: * -> *) a. Foldable t => t a -> Maybe a
IL.safeHeadG (t a -> a) -> t a -> a
forall a b. (a -> b) -> a -> b
$ t a
us
foldableQuantizerG
:: (Ord a, Floating a, IL.InsertLeft t1 a, Monoid (t1 a), F.Foldable t2) => Bool
-> (t1 a -> a -> Ordering)
-> t1 a
-> t2 a
-> [a]
foldableQuantizerG :: forall a (t1 :: * -> *) (t2 :: * -> *).
(Ord a, Floating 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 = (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 -> (t1 a -> a -> Ordering) -> t1 a -> a -> Maybe a
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 = [a] -> a -> a -> a
forall a. Floating a => [a] -> a -> a -> a
Q.meanF2 (t1 a -> [a]
forall a. t1 a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t1 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 (t2 a -> [a]
forall a. t2 a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t2 a
xs) a
0 a
0
ys :: [a]
ys = (a -> [a] -> [a]) -> [a] -> t2 a -> [a]
forall a b. (a -> b -> b) -> b -> t2 a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.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) [] t2 a
xs
round2GM
:: (Ord a, Monad m, IL.InsertLeft t1 a, Monoid (t1 a)) => Bool
-> (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 a -> t1 a -> Bool
forall a. Eq a => a -> t1 a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`F.elem` t1 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
| t1 a -> Int
forall a. t1 a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length t1 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
| t1 a -> Bool
forall a. t1 a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t1 a
ts = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
u
| t1 a -> Bool
forall a. t1 a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
F.null t1 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 <- t1 a -> a -> m Ordering
f t1 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))
-> (t1 a -> Maybe (a, a)) -> t1 a -> (a, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t1 a -> Maybe (a, a)
forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Maybe (a, a)
minMax11 (t1 a -> (a, a)) -> t1 a -> (a, a)
forall a b. (a -> b) -> a -> b
$ t1 a
xs
(t1 a
ts,t1 a
us) = (a -> Bool) -> t1 a -> (t1 a, t1 a)
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a)) =>
(a -> Bool) -> t a -> (t a, t a)
IL.span (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
z) t1 a
xs
t :: Maybe a
t = t1 a -> Maybe a
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a)) =>
t a -> Maybe a
IL.safeLastG t1 a
ts
u :: Maybe a
u = t1 a -> Maybe a
forall (t :: * -> *) a. Foldable t => t a -> Maybe a
IL.safeHeadG t1 a
us
foldableQuantizerGM
:: (Ord a, Floating a, Monad m, IL.InsertLeft t1 a, Monoid (t1 a), F.Foldable t2) => Bool
-> (t1 a -> a -> m Ordering)
-> t1 a
-> t2 a
-> m [a]
foldableQuantizerGM :: forall a (m :: * -> *) (t1 :: * -> *) (t2 :: * -> *).
(Ord a, Floating 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 = (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 -> (t1 a -> a -> m Ordering) -> t1 a -> a -> m (Maybe a)
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 = [a] -> a -> a -> a
forall a. Floating a => [a] -> a -> a -> a
Q.meanF2 (t1 a -> [a]
forall a. t1 a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t1 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 (t2 a -> [a]
forall a. t2 a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t2 a
xs) a
0 a
0
ys :: [a]
ys = (a -> [a] -> [a]) -> [a] -> t2 a -> [a]
forall a b. (a -> b -> b) -> b -> t2 a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.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) [] t2 a
xs