-- |
-- Module      :  Data.Filters.Basic
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- A module allows to change the structure of the function output for the functions of
-- elements from 'RealFrac' class. At the moment only the equal intervals are supported.
-- Has basic functions for the filters. Is taken from the @uniqueness-periods-vector-filters@ package
-- that is intended to be rewritten. These functions are basic for it and for its successor,
-- @phonetic-languages-filters-array@ package.

module Data.Filters.Basic (
  -- * One interval used
  intervalNRealFrac
  , zero2One
  , unsafeTransfer1I5
  , transfer1IEq3
) where

-- | Given the minimum and maximum elements, a quantity of equal intervals, and an element in between the first two arguments (or equal to one of them), finds out the
-- index of the interval, to which the element belongs (starting from 1). The minimum element belongs to the interval with the index 1.
intervalNRealFrac
  :: (RealFrac b, Integral c) => b
  -> b
  -> c
  -> b
  -> c
intervalNRealFrac :: b -> b -> c -> b -> c
intervalNRealFrac b
minE b
maxE c
n b
x
 | b
maxE b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
minE = Double -> c
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
* c -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral c
n)
 | Bool
otherwise = c -> c
forall a. Integral a => a -> a
zero2One (c -> c) -> (b -> c) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (b -> c) -> b -> c
forall a b. (a -> b) -> a -> b
$ c -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral c
n b -> b -> b
forall a. Num a => a -> a -> a
* (b
x b -> b -> b
forall a. Num a => a -> a -> a
- b
minE) b -> b -> b
forall a. Fractional a => a -> a -> a
/ (b
maxE b -> b -> b
forall a. Num a => a -> a -> a
- b
minE)
{-# INLINE intervalNRealFrac #-}

zero2One :: Integral a => a -> a
zero2One :: a -> a
zero2One a
x = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then a
1 else a
x
{-# INLINE zero2One #-}

-- | Moves (if needed) the given value so that its result divides the new [min..max] interval in the same proportion as the starting one. Is intended to be used
-- for the arguments satisfying some additional constraints, but they are not checked (hence, its name prefix \"unsafe\"). For example, the second argument must be
-- greater than the first one, the fourth -- than the third one, and the fifth must be located in between the first two. Then the result is also located in between
-- the third and fourth arguments similarly.
unsafeTransfer1I5
  :: RealFrac b => b
  -> b
  -> b
  -> b
  -> b
  -> b
unsafeTransfer1I5 :: b -> b -> b -> b -> b -> b
unsafeTransfer1I5 b
minE0 b
maxE0 b
minE1 b
maxE1 b
x
 | b
minE0 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
maxE0 = b
x
 | Bool
otherwise = b
minE1 b -> b -> b
forall a. Num a => a -> a -> a
+ (b
x b -> b -> b
forall a. Num a => a -> a -> a
- b
minE0) b -> b -> b
forall a. Num a => a -> a -> a
* (b
maxE1 b -> b -> b
forall a. Num a => a -> a -> a
- b
minE1) b -> b -> b
forall a. Fractional a => a -> a -> a
/ (b
maxE0 b -> b -> b
forall a. Num a => a -> a -> a
- b
minE0)
{-# INLINE unsafeTransfer1I5 #-}

-- | A variant of the 'unsafeTransfer1I5' where the lengths of the both intervals (the old and the new ones) are equal.
transfer1IEq3
  :: RealFrac b => b
  -> b
  -> b
  -> b
transfer1IEq3 :: b -> b -> b -> b
transfer1IEq3 b
minE0 b
minE1 = (b -> b -> b
forall a. Num a => a -> a -> a
+ (b
minE1 b -> b -> b
forall a. Num a => a -> a -> a
- b
minE0))
{-# INLINE transfer1IEq3 #-}