quantizer-0.1.0.0: TwoQuantizer.hs

module TwoQuantizer where

import Data.Maybe
import Numeric.Stats (meanD)

round2 
  :: Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. 
  -> Double 
  -> Double 
  -> Double 
  -> Maybe Double -- ^ The numeric value (in 'Just' case) can be equal just to the one of the two first arguments.
round2 bool x y z 
 | x <= 0 || y <= 0 || z <= 0 = Nothing
 | (x - z) * (y - z) <= 0 = Just (case compare (z*z) (x*y) of { GT -> max x y; LT -> min x y; EQ -> (if bool then max else min) x y })
 | otherwise = Nothing

round2L 
 :: Bool  -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. 
 -> [Double] 
 -> Double 
 -> Double
round2L ctrl ts x 
 | null ts = x
 | null ks = y
 | null us = y0
 | x < y = fromJust . round2 ctrl y0 y $ x
 | otherwise = y
  where (ks, us) = span (<x) ts
        y = head us
        y0 = last ks

twoQuantizer 
 :: Bool  -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. 
 -> [Double] 
 -> [Double] 
 -> [Double]
twoQuantizer ctrl needs xs = map (round2L ctrl needs) ys
  where k = meanD needs / meanD xs
        ys = map (*k) xs

round2G 
 :: (Ord a) => Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. 
 -> (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 bool f x y z 
 | z == x = Just x
 | z == y = Just y
 | (x < z && y > z) || (x > z && y < z) = Just (case f x y z of { GT -> max x y; LT -> min x y; EQ -> (if bool then max else min) x y })
 | otherwise = Nothing

round2GL 
 :: (Ord a) => Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. 
 -> (a -> a -> a -> Ordering) 
 -> [a] 
 -> a 
 -> a
round2GL ctrl f ts x 
 | null ts = x
 | null ks = y
 | null us = y0
 | x < y = fromJust . round2G ctrl f y0 y $ x
 | otherwise = y
  where (ks, us) = span (<x) ts
        y = head us
        y0 = last 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. 
 -> (a -> a -> a -> Ordering) 
 -> [a] 
 -> [a] 
 -> [a]
twoQuantizerG ctrl f needs xs = map (round2GL ctrl f needs) ys
  where k = meanF2 needs 0 0 / meanF2 xs 0 0
        ys = map (*k) xs

round2GM 
 :: (Ord a, Monad m) => Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. 
 -> (a -> a -> a -> m Ordering) 
 -> a 
 -> a 
 -> a 
 -> m (Maybe a)
round2GM bool f x y z 
 | z == x = return . Just $ x
 | z == y = return . Just $ y
 | (x < z && y > z) || (x > z && y < z) = do
     t <- f x y z
     case t of { GT -> return . Just . max x $ y; LT -> return . Just . min x $ y; EQ -> return. Just $ (if bool then max else min) x y }
 | otherwise = return Nothing

round2GLM 
 :: (Ord a, Monad m) => Bool -- ^ If 'True' then the function rounds the result in the ambiguous situation to the greater value. 
 -> (a -> a -> a -> m Ordering) 
 -> [a] 
 -> a 
 -> m a
round2GLM ctrl f ts x 
 | null ts = return x
 | null ks = return y
 | null us = return y0
 | x < y = fmap fromJust . round2GM ctrl f y0 y $ x 
 | otherwise = return y
  where (ks, us) = span (<x) ts
        y = head us
        y0 = last ks

meanF2 
 :: (Floating a, Integral a) => [a] 
 -> a 
 -> a 
 -> a
meanF2 (t:ts) s l = meanF2 ts (s + t) (l + 1) 
meanF2 _ s l = s / fromIntegral 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. 
 -> (a -> a -> a -> m Ordering) 
 -> [a] 
 -> [a] 
 -> m [a]
twoQuantizerGM ctrl f needs xs = mapM (round2GLM ctrl f needs) ys
  where k = meanF2 needs 0 0  / meanF2 xs 0 0
        ys = map (*k) xs