-- |
-- Module      :  DobutokO.Sound.Functional.Elements
-- Copyright   :  (c) OleksandrZhabenko 2020, 2024
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Helps to create experimental music from a file (or its part) and a Ukrainian text. 
-- It can also generate a timbre for the notes. Uses SoX inside.

{-# OPTIONS_GHC -threaded #-}

module DobutokO.Sound.Functional.Elements (
  -- * Functions to edit OvertonesO and function f
  renormF
  , renormFD
  , sameOvertone
  , sameOvertoneL  
  , sameFreqF
  , sameFreqFI
  , fAddFElem
  , fRemoveFElem
  , fChangeFElem
  , gAdd01
  , gAdd02
  , gAdd03
  , gAdd04
  , gRem01
  , gRem02
  , gRem03
  -- ** Working with two OvertonesO
  , fAddFElems
  , fRemoveFElems
  , fChangeFElems
  , freqsOverlapOvers
  , elemsOverlapOvers
  , gAdds01
  , gAdds02
) where

import Data.List (sort,sortBy)
import qualified Data.Vector as V
import DobutokO.Sound.Functional.Basics

-- | Renormalizes amplitudes for the frequencies so that the maximum one of them (if 'OvertonesO' is not 'V.empty') is equal by the absolute value
-- to 1.0 and the mutual ratios of the amplitudes are preserved.
renormF :: OvertonesO -> OvertonesO
renormF :: OvertonesO -> OvertonesO
renormF OvertonesO
v
 | OvertonesO -> Bool
forall a. Vector a -> Bool
V.null OvertonesO
v = OvertonesO
forall a. Vector a
V.empty
 | Bool
otherwise =
    let v1 :: OvertonesO
v1 = [(Float, Float)] -> OvertonesO
forall a. [a] -> Vector a
V.fromList ([(Float, Float)] -> OvertonesO)
-> (OvertonesO -> [(Float, Float)]) -> OvertonesO -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> (Float, Float) -> Ordering)
-> [(Float, Float)] -> [(Float, Float)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Float
_,Float
y1) (Float
_,Float
y2)-> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
y2) (Float -> Float
forall a. Num a => a -> a
abs Float
y1)) ([(Float, Float)] -> [(Float, Float)])
-> (OvertonesO -> [(Float, Float)])
-> OvertonesO
-> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> [(Float, Float)]
forall a. Vector a -> [a]
V.toList (OvertonesO -> OvertonesO) -> OvertonesO -> OvertonesO
forall a b. (a -> b) -> a -> b
$ OvertonesO
v in
      if (\(Float
_,Float
y) -> Float
y Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0.0) ((Float, Float) -> Bool) -> (Int -> (Float, Float)) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> Int -> (Float, Float)
forall a. Vector a -> Int -> a
V.unsafeIndex OvertonesO
v1 (Int -> Bool) -> Int -> Bool
forall a b. (a -> b) -> a -> b
$ Int
0 then OvertonesO
forall a. Vector a
V.empty
      else ((Float, Float) -> (Float, Float)) -> OvertonesO -> OvertonesO
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Float
x,Float
y) -> (Float
x, Float
y Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ ((Float, Float) -> Float
forall a b. (a, b) -> b
snd ((Float, Float) -> Float)
-> (Int -> (Float, Float)) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> Int -> (Float, Float)
forall a. Vector a -> Int -> a
V.unsafeIndex OvertonesO
v1 (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int
0))) OvertonesO
v1

-- | Renormalizes amplitudes for the frequencies so that the maximum one of them (if 'OvertonesO' is not 'V.empty') is equal by the absolute value
-- to 'Float' argument and the mutual ratios of the amplitudes are preserved.
renormFD :: Float -> OvertonesO -> OvertonesO
renormFD :: Float -> OvertonesO -> OvertonesO
renormFD Float
ampl0 OvertonesO
v
 | OvertonesO -> Bool
forall a. Vector a -> Bool
V.null OvertonesO
v = OvertonesO
forall a. Vector a
V.empty
 | Bool
otherwise =
    let v1 :: OvertonesO
v1 = [(Float, Float)] -> OvertonesO
forall a. [a] -> Vector a
V.fromList ([(Float, Float)] -> OvertonesO)
-> (OvertonesO -> [(Float, Float)]) -> OvertonesO -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> (Float, Float) -> Ordering)
-> [(Float, Float)] -> [(Float, Float)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Float
_,Float
y1) (Float
_,Float
y2)-> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
y2) (Float -> Float
forall a. Num a => a -> a
abs Float
y1)) ([(Float, Float)] -> [(Float, Float)])
-> (OvertonesO -> [(Float, Float)])
-> OvertonesO
-> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> [(Float, Float)]
forall a. Vector a -> [a]
V.toList (OvertonesO -> OvertonesO) -> OvertonesO -> OvertonesO
forall a b. (a -> b) -> a -> b
$ OvertonesO
v in
      if (\(Float
_,Float
y) -> Float
y Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0.0) ((Float, Float) -> Bool) -> (Int -> (Float, Float)) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> Int -> (Float, Float)
forall a. Vector a -> Int -> a
V.unsafeIndex OvertonesO
v1 (Int -> Bool) -> Int -> Bool
forall a b. (a -> b) -> a -> b
$ Int
0 then OvertonesO
forall a. Vector a
V.empty
      else ((Float, Float) -> (Float, Float)) -> OvertonesO -> OvertonesO
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Float
x,Float
y) -> (Float
x, Float
ampl0 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
y Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ ((Float, Float) -> Float
forall a b. (a, b) -> b
snd ((Float, Float) -> Float)
-> (Int -> (Float, Float)) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> Int -> (Float, Float)
forall a. Vector a -> Int -> a
V.unsafeIndex OvertonesO
v1 (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int
0))) OvertonesO
v1

-- | Predicate to check whether all tuples in a 'V.Vector' have the same first element.
sameOvertone :: OvertonesO -> Bool
sameOvertone :: OvertonesO -> Bool
sameOvertone OvertonesO
v
 | OvertonesO -> Bool
forall a. Vector a -> Bool
V.null OvertonesO
v = Bool
False
 | Bool
otherwise = ((Float, Float) -> Bool) -> OvertonesO -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
V.all (\(Float
x,Float
_) -> Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== ((Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float)
-> (Int -> (Float, Float)) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> Int -> (Float, Float)
forall a. Vector a -> Int -> a
V.unsafeIndex OvertonesO
v (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int
0)) OvertonesO
v

-- | Similar to 'sameOvertone', except that not the 'V.Vector' is checked but a corresponding list.
sameOvertoneL :: [(Float,Float)] -> Bool
sameOvertoneL :: [(Float, Float)] -> Bool
sameOvertoneL xs :: [(Float, Float)]
xs@((Float
x,Float
_):[(Float, Float)]
_) = ((Float, Float) -> Bool) -> [(Float, Float)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(Float
xn,Float
_) -> Float
xn Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
x) [(Float, Float)]
xs
sameOvertoneL [(Float, Float)]
_ = Bool
False

-- | @g :: (Float,Float) -> OvertonesO -> OvertonesO@ is a function that defines how the new element is added to the 'OvertonesO'. It depends
-- only on the element being added and the actual 'OvertonesO'. It does not depend on the 'Float' argument for @f :: Float -> OvertonesO@
-- so for different 'Float' for @f@ it gives the same result.
sameFreqF :: Float -> (Float,Float) -> (Float -> OvertonesO) -> ((Float,Float) -> OvertonesO -> OvertonesO) -> OvertonesO
sameFreqF :: Float
-> (Float, Float)
-> (Float -> OvertonesO)
-> ((Float, Float) -> OvertonesO -> OvertonesO)
-> OvertonesO
sameFreqF Float
freq (Float
noteN0,Float
amplN0) Float -> OvertonesO
f (Float, Float) -> OvertonesO -> OvertonesO
g = (Float, Float) -> OvertonesO -> OvertonesO
g (Float
noteN0,Float
amplN0) (Float -> OvertonesO
f Float
freq)

-- | @g :: (Float,Float) -> OvertonesO -> OvertonesO@ is a function that defines how the new element is added to the 'OvertonesO'.
-- Variant of 'sameFreqF' where g depends only on the elements of the 'OvertonesO', which first elements in the tuples equal to the first element
-- in the @(Float,Float)@. It does not depend on the 'Float' argument for @f :: Float -> OvertonesO@
-- so for different 'Float' for @f@ it gives the same result.
sameFreqFI :: Float -> (Float,Float) -> (Float -> OvertonesO) -> ((Float,Float) -> OvertonesO -> OvertonesO) -> OvertonesO
sameFreqFI :: Float
-> (Float, Float)
-> (Float -> OvertonesO)
-> ((Float, Float) -> OvertonesO -> OvertonesO)
-> OvertonesO
sameFreqFI Float
freq (Float
noteN0,Float
amplN0) Float -> OvertonesO
f (Float, Float) -> OvertonesO -> OvertonesO
g = (Float, Float) -> OvertonesO -> OvertonesO
g (Float
noteN0,Float
amplN0) (OvertonesO -> OvertonesO)
-> (OvertonesO -> OvertonesO) -> OvertonesO -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> Bool) -> OvertonesO -> OvertonesO
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (\(Float
x,Float
_) -> Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
noteN0) (OvertonesO -> OvertonesO) -> OvertonesO -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Float -> OvertonesO
f Float
freq

-- | @gAdd :: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO@ is a function that defines how the element is added
-- to the 'OvertonesO'. 'fAddFElem' is 
-- actually a higher-order function, it changes the function @f@ and returns a new one. It can be an interesting task 
-- (in general) to look at such a function through a prism of notion of operator (mathematical, for example similar to that ones that 
-- are used for quantum mechanics and quantum field theory). 
-- @gAdd@ allows not only to insert an element if missing, but to change all the 'OvertonesO' system. So depending on the complexity,
-- it can produce rather complex behaviour.
fAddFElem :: (Float, Float) -> (Float -> OvertonesO) -> ((Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO) ->
  (Float -> OvertonesO)
fAddFElem :: (Float, Float)
-> (Float -> OvertonesO)
-> ((Float, Float) -> Float -> (Float -> OvertonesO) -> OvertonesO)
-> Float
-> OvertonesO
fAddFElem (Float
noteN, Float
amplN) Float -> OvertonesO
f (Float, Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdd Float
t = (Float, Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdd (Float
noteN, Float
amplN) Float
t Float -> OvertonesO
f

-- | @gRem:: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO@ is a function that defines how the element is removed
-- from the 'OvertonesO'. 'fRemoveFElem' is
-- actually a higher-order function, it changes the function @f@ and returns a new one. It can be an interesting task 
-- (in general) to look at such a function through a prism of notion of operator (mathematical, for example that ones that are used 
-- for quantum mechanics and quantum field theory). 
-- @gRem@ allows not only to delete an element if existing, but to change all the 'OvertonesO' system. So depending on the complexity,
-- it can produce rather complex behaviour.
fRemoveFElem :: (Float, Float) -> (Float -> OvertonesO) -> ((Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO) -> 
  (Float -> OvertonesO)
fRemoveFElem :: (Float, Float)
-> (Float -> OvertonesO)
-> ((Float, Float) -> Float -> (Float -> OvertonesO) -> OvertonesO)
-> Float
-> OvertonesO
fRemoveFElem (Float
noteN, Float
amplN) Float -> OvertonesO
f (Float, Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gRem Float
t = (Float, Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gRem (Float
noteN, Float
amplN) Float
t Float -> OvertonesO
f

-- | Changes elements of the 'OvertonesO' using two functions. It is a generalization of the 'fAddFElem' and 'fRemoveFElem' functions. For example, if the first 
-- of the two inner functional arguments acts as 'gAdd01' or similar, then it adds element to the 'OvertonesO', if it acts as 'gRem01', then it removes the element. 
-- Its behaviour is defined by the 'Float' parameter (meaning frequency, probably), so you can change elements depending on what point it is applied.
fChangeFElem :: (Float, Float) -> Float -> (Float -> ((Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO)) -> (Float -> OvertonesO) -> 
  (Float -> OvertonesO)
fChangeFElem :: (Float, Float)
-> Float
-> (Float
    -> (Float, Float) -> Float -> (Float -> OvertonesO) -> OvertonesO)
-> (Float -> OvertonesO)
-> Float
-> OvertonesO
fChangeFElem (Float
noteN, Float
amplN) Float
freq Float
-> (Float, Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
h Float -> OvertonesO
f Float
t = (Float
-> (Float, Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
h Float
freq) (Float
noteN, Float
amplN) Float
t Float -> OvertonesO
f

-- | Example of the function gAdd for the 'fAddFElem'. If the frequency is already in the 'OvertonesO' then the corresponding amplitude is divided
-- equally between all the elements with the repeated given frequency from @(Float, Float)@. Otherwise, it is just concatenated to the 'OvertonesO'.
gAdd01 :: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdd01 :: (Float, Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdd01 (Float
note,Float
ampl) Float
freq Float -> OvertonesO
f 
 | OvertonesO -> Bool
forall a. Vector a -> Bool
V.null (OvertonesO -> Bool) -> (Float -> OvertonesO) -> Float -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
f (Float -> Bool) -> Float -> Bool
forall a b. (a -> b) -> a -> b
$ Float
freq = (Float, Float) -> OvertonesO
forall a. a -> Vector a
V.singleton (Float
note,Float
ampl)
 | Bool
otherwise =
    let v1 :: OvertonesO
v1 = OvertonesO -> OvertonesO
renormF (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
f (Float -> OvertonesO) -> Float -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Float
freq in
     let v2 :: Vector Int
v2 = ((Float, Float) -> Bool) -> OvertonesO -> Vector Int
forall a. (a -> Bool) -> Vector a -> Vector Int
V.findIndices (\(Float
x,Float
_) -> Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
note) OvertonesO
v1 in
       if Vector Int -> Bool
forall a. Vector a -> Bool
V.null Vector Int
v2 then (Float, Float) -> OvertonesO -> OvertonesO
forall a. a -> Vector a -> Vector a
V.cons (Float
note,Float
ampl) (Float -> OvertonesO
f Float
freq)
       else OvertonesO -> OvertonesO
renormF (OvertonesO -> OvertonesO)
-> (OvertonesO -> OvertonesO) -> OvertonesO -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (Float, Float) -> (Float, Float))
-> OvertonesO -> OvertonesO
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap (\Int
i (Float
t,Float
w) -> if Int
i Int -> Vector Int -> Bool
forall a. Eq a => a -> Vector a -> Bool
`V.elem` Vector Int
v2 then (Float
t,Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ampl Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Int -> Int
forall a. Vector a -> Int
V.length Vector Int
v2)) else (Float
t,Float
w)) (OvertonesO -> OvertonesO) -> OvertonesO -> OvertonesO
forall a b. (a -> b) -> a -> b
$ OvertonesO
v1

-- | Can be used to produce an example of the function @gAdd@ for the 'fAddFElem'. Similar to 'gAdd01', but uses its first argument
-- to renorm the result of the 'gAdd01' so that its maximum by absolute value amplitude equals to the first argument.
gAdd02 :: Float -> (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdd02 :: Float
-> (Float, Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdd02 Float
amplMax (Float
note,Float
ampl) Float
freq = Float -> OvertonesO -> OvertonesO
renormFD Float
amplMax (OvertonesO -> OvertonesO)
-> ((Float -> OvertonesO) -> OvertonesO)
-> (Float -> OvertonesO)
-> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float, Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdd01 (Float
note,Float
ampl) Float
freq

-- | Example of the function @gAdd@. for the 'fAddFElem'. If the frequency is not already in the 'OvertonesO' then the corresponding element is added and
-- the 'OvertonesO' are renormed with 'renormF'. Otherwise, the element is tried to be inserted with a new frequency between the greatest by an absolute
-- values notes as an intermediate value with the respective amplitude, or if there is only one element, to produce two elements in
-- the resulting 'V.Vector' with two consequent harmonics.
gAdd03 :: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdd03 :: (Float, Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdd03 (Float
note,Float
ampl) Float
freq Float -> OvertonesO
f 
 | OvertonesO -> Bool
forall a. Vector a -> Bool
V.null (OvertonesO -> Bool) -> (Float -> OvertonesO) -> Float -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
f (Float -> Bool) -> Float -> Bool
forall a b. (a -> b) -> a -> b
$ Float
freq = (Float, Float) -> OvertonesO
forall a. a -> Vector a
V.singleton (Float
note,Float
ampl)
 | Bool
otherwise =
    let v1 :: OvertonesO
v1 = OvertonesO -> OvertonesO
renormF (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
f (Float -> OvertonesO) -> Float -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Float
freq in
     let v2 :: Vector Int
v2 = ((Float, Float) -> Bool) -> OvertonesO -> Vector Int
forall a. (a -> Bool) -> Vector a -> Vector Int
V.findIndices (\(Float
x,Float
_) -> Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
note) OvertonesO
v1 in
       if Vector Int -> Bool
forall a. Vector a -> Bool
V.null Vector Int
v2 then OvertonesO -> OvertonesO
renormF (OvertonesO -> OvertonesO)
-> (OvertonesO -> OvertonesO) -> OvertonesO -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float, Float) -> OvertonesO -> OvertonesO
forall a. a -> Vector a -> Vector a
V.cons (Float
note,Float
ampl) (OvertonesO -> OvertonesO) -> OvertonesO -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Float -> OvertonesO
f Float
freq
       else
        let xs :: [(Float, Float)]
xs = ((Float, Float) -> (Float, Float) -> Ordering)
-> [(Float, Float)] -> [(Float, Float)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Float
x1,Float
_) (Float
x2,Float
_)-> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs Float
x2) (Float -> Float
forall a. Num a => a -> a
abs Float
x1)) ([(Float, Float)] -> [(Float, Float)])
-> (OvertonesO -> [(Float, Float)])
-> OvertonesO
-> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> [(Float, Float)]
forall a. Vector a -> [a]
V.toList (OvertonesO -> [(Float, Float)]) -> OvertonesO -> [(Float, Float)]
forall a b. (a -> b) -> a -> b
$ OvertonesO
v1
            l :: Int
l = OvertonesO -> Int
forall a. Vector a -> Int
V.length OvertonesO
v1
            ys :: [(Float, Float)]
ys = if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l Int
1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then (((Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float)
-> ([(Float, Float)] -> (Float, Float))
-> [(Float, Float)]
-> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Float, Float)] -> (Float, Float)
forall a. HasCallStack => [a] -> a
head ([(Float, Float)] -> Float) -> [(Float, Float)] -> Float
forall a b. (a -> b) -> a -> b
$ [(Float, Float)]
xs) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ ((Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float)
-> ([(Float, Float)] -> (Float, Float))
-> [(Float, Float)]
-> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Float, Float)] -> (Float, Float)
forall a. HasCallStack => [a] -> a
head ([(Float, Float)] -> (Float, Float))
-> ([(Float, Float)] -> [(Float, Float)])
-> [(Float, Float)]
-> (Float, Float)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Float, Float)] -> [(Float, Float)]
forall a. HasCallStack => [a] -> [a]
tail ([(Float, Float)] -> Float) -> [(Float, Float)] -> Float
forall a b. (a -> b) -> a -> b
$ [(Float, Float)]
xs) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2,Float
ampl)(Float, Float) -> [(Float, Float)] -> [(Float, Float)]
forall a. a -> [a] -> [a]
:[(Float, Float)]
xs
                 else [(Float
note,(((Float, Float) -> Float
forall a b. (a, b) -> b
snd ((Float, Float) -> Float)
-> (Int -> (Float, Float)) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> Int -> (Float, Float)
forall a. Vector a -> Int -> a
V.unsafeIndex OvertonesO
v1 (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int
0) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ampl) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2),(Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
note,(Float -> Float
forall a. Num a => a -> a
abs (((Float, Float) -> Float
forall a b. (a, b) -> b
snd ((Float, Float) -> Float)
-> (Int -> (Float, Float)) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> Int -> (Float, Float)
forall a. Vector a -> Int -> a
V.unsafeIndex OvertonesO
v1 (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ Int
0) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
ampl)) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2)] in
                   OvertonesO -> OvertonesO
renormF (OvertonesO -> OvertonesO)
-> ([(Float, Float)] -> OvertonesO)
-> [(Float, Float)]
-> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Float, Float)] -> OvertonesO
forall a. [a] -> Vector a
V.fromList ([(Float, Float)] -> OvertonesO) -> [(Float, Float)] -> OvertonesO
forall a b. (a -> b) -> a -> b
$ [(Float, Float)]
ys

-- | Example of the function gRem for the 'fRemoveFElem'. If the element is already in the 'OvertonesO' then it is removed (if there are more than 5
-- elements already) and 'OvertonesO' are renormalized. Otherwise, all the same for the element already existing elements become less in an amlitude
-- for a numbers that in sum equal to amplitude of the removed element.
gRem01 :: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gRem01 :: (Float, Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gRem01 (Float
note,Float
ampl) Float
freq Float -> OvertonesO
f
  | OvertonesO -> Bool
forall a. Vector a -> Bool
V.null (OvertonesO -> Bool) -> (Float -> OvertonesO) -> Float -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
f (Float -> Bool) -> Float -> Bool
forall a b. (a -> b) -> a -> b
$ Float
freq = OvertonesO
forall a. Vector a
V.empty
  | Bool
otherwise =
     let v1 :: OvertonesO
v1 = OvertonesO -> OvertonesO
renormF (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
f (Float -> OvertonesO) -> Float -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Float
freq in
     let v2 :: Vector Int
v2 = ((Float, Float) -> Bool) -> OvertonesO -> Vector Int
forall a. (a -> Bool) -> Vector a -> Vector Int
V.findIndices (\(Float
x,Float
y) -> Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
note Bool -> Bool -> Bool
&& Float
y Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
ampl) OvertonesO
v1 in
       if Vector Int -> Bool
forall a. Vector a -> Bool
V.null Vector Int
v2 then
       if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (OvertonesO -> Int
forall a. Vector a -> Int
V.length OvertonesO
v1) Int
5 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT then OvertonesO -> OvertonesO
renormF (OvertonesO -> OvertonesO)
-> (OvertonesO -> OvertonesO) -> OvertonesO -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> OvertonesO -> OvertonesO
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
0 (OvertonesO -> Int
forall a. Vector a -> Int
V.length OvertonesO
v1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (OvertonesO -> OvertonesO) -> OvertonesO -> OvertonesO
forall a b. (a -> b) -> a -> b
$ OvertonesO
v1
       else OvertonesO
v1
       else OvertonesO -> OvertonesO
renormF (OvertonesO -> OvertonesO)
-> (OvertonesO -> OvertonesO) -> OvertonesO -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (Float, Float) -> (Float, Float))
-> OvertonesO -> OvertonesO
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap (\Int
i (Float
t,Float
w) -> if Int
i Int -> Vector Int -> Bool
forall a. Eq a => a -> Vector a -> Bool
`V.elem` Vector Int
v2 then (Float
t,Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
ampl Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Int -> Int
forall a. Vector a -> Int
V.length Vector Int
v2)) else (Float
t,Float
w)) (OvertonesO -> OvertonesO) -> OvertonesO -> OvertonesO
forall a b. (a -> b) -> a -> b
$ OvertonesO
v1

-- | Can be used to produce an example of the function @gRem@ for the 'fRemoveFElem'. Similar to 'gRem01', but uses its first argument
-- to renorm the result of the 'gRem01' so that its maximum by absolute value amplitude equals to the first argument.
gRem02 :: Float -> (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gRem02 :: Float
-> (Float, Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gRem02 Float
amplMax (Float
note,Float
ampl) Float
freq = Float -> OvertonesO -> OvertonesO
renormFD Float
amplMax (OvertonesO -> OvertonesO)
-> ((Float -> OvertonesO) -> OvertonesO)
-> (Float -> OvertonesO)
-> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float, Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdd01 (Float
note,Float
ampl) Float
freq

-- | Similar to 'fAddFElem', but instead of one element @(Float,Float)@ it deals with a 'V.Vector' of such elements that is 'OvertonesO'. 
fAddFElems :: OvertonesO -> (Float -> OvertonesO) -> (OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO) ->
  (Float -> OvertonesO)
fAddFElems :: OvertonesO
-> (Float -> OvertonesO)
-> (OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO)
-> Float
-> OvertonesO
fAddFElems OvertonesO
v Float -> OvertonesO
f OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdds Float
t = OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdds OvertonesO
v Float
t Float -> OvertonesO
f

-- | Similar to 'fRemoveFElem', but instead of one element @(Float,Float)@ it deals with a 'V.Vector' of such elements that is 'OvertonesO'. 
fRemoveFElems :: OvertonesO -> (Float -> OvertonesO) -> (OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO) -> 
  (Float -> OvertonesO)
fRemoveFElems :: OvertonesO
-> (Float -> OvertonesO)
-> (OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO)
-> Float
-> OvertonesO
fRemoveFElems OvertonesO
v Float -> OvertonesO
f OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO
gRems Float
t = OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO
gRems OvertonesO
v Float
t Float -> OvertonesO
f

-- | Similar to 'fChangeFElem', but use another form of the changing function, so it can deal with not only single element of the 'OvertonesO', 
-- but also with several ones.
fChangeFElems :: OvertonesO -> Float -> (Float -> (OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO)) -> (Float -> OvertonesO) -> 
  (Float -> OvertonesO)
fChangeFElems :: OvertonesO
-> Float
-> (Float
    -> OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO)
-> (Float -> OvertonesO)
-> Float
-> OvertonesO
fChangeFElems OvertonesO
v Float
freq Float -> OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO
h Float -> OvertonesO
f Float
t = (Float -> OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO
h Float
freq) OvertonesO
v Float
t Float -> OvertonesO
f

-- | Binary predicate to check whether two given 'OvertonesO' both have the elements with the same first element in the tuples. If 'True' then
-- this means that 'OvertonesO' are at least partially overlaped by the first elements in the tuples (meaning frequencies). 
freqsOverlapOvers :: OvertonesO -> OvertonesO -> Bool
freqsOverlapOvers :: OvertonesO -> OvertonesO -> Bool
freqsOverlapOvers OvertonesO
v1 OvertonesO
v2 =
  let [Vector Float
v11,Vector Float
v21] = (OvertonesO -> Vector Float) -> [OvertonesO] -> [Vector Float]
forall a b. (a -> b) -> [a] -> [b]
map (((Float, Float) -> Float) -> OvertonesO -> Vector Float
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Float, Float) -> Float
forall a b. (a, b) -> a
fst) [OvertonesO
v1,OvertonesO
v2]
      v22 :: Vector Float
v22 = (Float -> Bool) -> Vector Float -> Vector Float
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Vector Float -> Float
forall a. Ord a => Vector a -> a
V.maximum Vector Float
v11) Vector Float
v21 in
        if Vector Float -> Bool
forall a. Vector a -> Bool
V.null Vector Float
v22 then Bool
False
        else
          let v12 :: Vector Float
v12 = (Float -> Bool) -> Vector Float -> Vector Float
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Vector Float -> Float
forall a. Ord a => Vector a -> a
V.minimum Vector Float
v21) Vector Float
v11
              [Vector Float
v13,Vector Float
v23] = (Vector Float -> Vector Float) -> [Vector Float] -> [Vector Float]
forall a b. (a -> b) -> [a] -> [b]
map (Vector Float -> Vector Float
forall a. Eq a => Vector a -> Vector a
V.uniq (Vector Float -> Vector Float)
-> (Vector Float -> Vector Float) -> Vector Float -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Float] -> Vector Float
forall a. [a] -> Vector a
V.fromList ([Float] -> Vector Float)
-> (Vector Float -> [Float]) -> Vector Float -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Float] -> [Float]
forall a. Ord a => [a] -> [a]
sort ([Float] -> [Float])
-> (Vector Float -> [Float]) -> Vector Float -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Float -> [Float]
forall a. Vector a -> [a]
V.toList) [Vector Float
v12,Vector Float
v22]
              [Int
l1,Int
l2]  = (Vector Float -> Int) -> [Vector Float] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Vector Float -> Int
forall a. Vector a -> Int
V.length [Vector Float
v13,Vector Float
v23] in Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Vector Float -> Int
forall a. Vector a -> Int
V.length (Vector Float -> Int)
-> ([Vector Float] -> Vector Float) -> [Vector Float] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Float -> Vector Float
forall a. Eq a => Vector a -> Vector a
V.uniq (Vector Float -> Vector Float)
-> ([Vector Float] -> Vector Float)
-> [Vector Float]
-> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Float] -> Vector Float
forall a. [a] -> Vector a
V.fromList ([Float] -> Vector Float)
-> ([Vector Float] -> [Float]) -> [Vector Float] -> Vector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Float] -> [Float]
forall a. Ord a => [a] -> [a]
sort ([Float] -> [Float])
-> ([Vector Float] -> [Float]) -> [Vector Float] -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Float -> [Float]
forall a. Vector a -> [a]
V.toList (Vector Float -> [Float])
-> ([Vector Float] -> Vector Float) -> [Vector Float] -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vector Float] -> Vector Float
forall a. [Vector a] -> Vector a
V.concat ([Vector Float] -> Int) -> [Vector Float] -> Int
forall a b. (a -> b) -> a -> b
$ [Vector Float
v13,Vector Float
v23]) (Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l2) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT

-- | Similar to 'freqsOverlapOvers', but checks whether the whole tuples are the same instead of the first elements in the tuples are the same.
elemsOverlapOvers :: OvertonesO -> OvertonesO -> Bool
elemsOverlapOvers :: OvertonesO -> OvertonesO -> Bool
elemsOverlapOvers OvertonesO
v1 OvertonesO
v2 =
  let v22 :: OvertonesO
v22 = ((Float, Float) -> Bool) -> OvertonesO -> OvertonesO
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (\(Float
x,Float
_) -> Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= (Float, Float) -> Float
forall a b. (a, b) -> a
fst (((Float, Float) -> (Float, Float) -> Ordering)
-> OvertonesO -> (Float, Float)
forall a. (a -> a -> Ordering) -> Vector a -> a
V.maximumBy (\(Float
x1,Float
_) (Float
t,Float
_) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x1 Float
t) OvertonesO
v1)) OvertonesO
v2 in
        if OvertonesO -> Bool
forall a. Vector a -> Bool
V.null OvertonesO
v22 then Bool
False
        else
          let v12 :: OvertonesO
v12 = ((Float, Float) -> Bool) -> OvertonesO -> OvertonesO
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (\(Float
x,Float
_) -> Float
x Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= (Float, Float) -> Float
forall a b. (a, b) -> a
fst (((Float, Float) -> (Float, Float) -> Ordering)
-> OvertonesO -> (Float, Float)
forall a. (a -> a -> Ordering) -> Vector a -> a
V.minimumBy (\(Float
x1,Float
_) (Float
t,Float
_) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x1 Float
t) OvertonesO
v2)) OvertonesO
v1
              [OvertonesO
v13,OvertonesO
v23] = (OvertonesO -> OvertonesO) -> [OvertonesO] -> [OvertonesO]
forall a b. (a -> b) -> [a] -> [b]
map (OvertonesO -> OvertonesO
forall a. Eq a => Vector a -> Vector a
V.uniq (OvertonesO -> OvertonesO)
-> (OvertonesO -> OvertonesO) -> OvertonesO -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Float, Float)] -> OvertonesO
forall a. [a] -> Vector a
V.fromList ([(Float, Float)] -> OvertonesO)
-> (OvertonesO -> [(Float, Float)]) -> OvertonesO -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Float, Float)] -> [(Float, Float)]
forall a. Ord a => [a] -> [a]
sort ([(Float, Float)] -> [(Float, Float)])
-> (OvertonesO -> [(Float, Float)])
-> OvertonesO
-> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> [(Float, Float)]
forall a. Vector a -> [a]
V.toList) [OvertonesO
v12,OvertonesO
v22]
              [Int
l1,Int
l2]  = (OvertonesO -> Int) -> [OvertonesO] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map OvertonesO -> Int
forall a. Vector a -> Int
V.length [OvertonesO
v13,OvertonesO
v23] in Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (OvertonesO -> Int
forall a. Vector a -> Int
V.length (OvertonesO -> Int)
-> ([OvertonesO] -> OvertonesO) -> [OvertonesO] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> OvertonesO
forall a. Eq a => Vector a -> Vector a
V.uniq (OvertonesO -> OvertonesO)
-> ([OvertonesO] -> OvertonesO) -> [OvertonesO] -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Float, Float)] -> OvertonesO
forall a. [a] -> Vector a
V.fromList ([(Float, Float)] -> OvertonesO)
-> ([OvertonesO] -> [(Float, Float)]) -> [OvertonesO] -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Float, Float)] -> [(Float, Float)]
forall a. Ord a => [a] -> [a]
sort ([(Float, Float)] -> [(Float, Float)])
-> ([OvertonesO] -> [(Float, Float)])
-> [OvertonesO]
-> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> [(Float, Float)]
forall a. Vector a -> [a]
V.toList (OvertonesO -> [(Float, Float)])
-> ([OvertonesO] -> OvertonesO) -> [OvertonesO] -> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OvertonesO] -> OvertonesO
forall a. [Vector a] -> Vector a
V.concat ([OvertonesO] -> Int) -> [OvertonesO] -> Int
forall a b. (a -> b) -> a -> b
$ [OvertonesO
v13,OvertonesO
v23]) (Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l2) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT

-- | Example of the function @gAdds@ for the 'fAddFElems'. 
gAdds01 :: OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdds01 :: OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdds01 OvertonesO
v0 Float
freq Float -> OvertonesO
f 
 | OvertonesO -> Bool
forall a. Vector a -> Bool
V.null (OvertonesO -> Bool) -> (Float -> OvertonesO) -> Float -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
f (Float -> Bool) -> Float -> Bool
forall a b. (a -> b) -> a -> b
$ Float
freq = OvertonesO
v0
 | OvertonesO -> OvertonesO -> Bool
freqsOverlapOvers OvertonesO
v0 (Float -> OvertonesO
f Float
freq) =
     let ys :: [(Float, Float)]
ys = ((Float, Float) -> (Float, Float) -> Ordering)
-> [(Float, Float)] -> [(Float, Float)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Float
x1,Float
_) (Float
x2,Float
_) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x1 Float
x2) ([(Float, Float)] -> [(Float, Float)])
-> (OvertonesO -> [(Float, Float)])
-> OvertonesO
-> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> [(Float, Float)]
forall a. Vector a -> [a]
V.toList (OvertonesO -> [(Float, Float)]) -> OvertonesO -> [(Float, Float)]
forall a b. (a -> b) -> a -> b
$ OvertonesO
v0
         h :: [a] -> [[a]]
h [a]
ys
          | [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
ys = []
          | Bool
otherwise = ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= [a] -> a
forall a. HasCallStack => [a] -> a
head [a]
ys)) [a]
ys)[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[a] -> [[a]]
h ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= [a] -> a
forall a. HasCallStack => [a] -> a
head [a]
ys)) [a]
ys)
         h1 :: [(Float, Float)] -> [Float]
h1 = ([(Float, Float)] -> Float) -> [[(Float, Float)]] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (\[(Float, Float)]
zs -> ([Float] -> Float
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Float] -> Float)
-> ([(Float, Float)] -> [Float]) -> [(Float, Float)] -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> Float) -> [(Float, Float)] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Float, Float) -> Float
forall a b. (a, b) -> b
snd ([(Float, Float)] -> Float) -> [(Float, Float)] -> Float
forall a b. (a -> b) -> a -> b
$ [(Float, Float)]
zs) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([(Float, Float)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Float, Float)]
zs)) ([[(Float, Float)]] -> [Float])
-> ([(Float, Float)] -> [[(Float, Float)]])
-> [(Float, Float)]
-> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Float, Float)] -> [[(Float, Float)]]
forall {a}. Eq a => [a] -> [[a]]
h
         h2 :: [(b, b)] -> [b]
h2 [(b, b)]
ys = ([(b, b)] -> b) -> [[(b, b)]] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((b, b) -> b
forall a b. (a, b) -> a
fst ((b, b) -> b) -> ([(b, b)] -> (b, b)) -> [(b, b)] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(b, b)] -> (b, b)
forall a. HasCallStack => [a] -> a
head) ([(b, b)] -> [[(b, b)]]
forall {a}. Eq a => [a] -> [[a]]
h [(b, b)]
ys)
         v2 :: OvertonesO
v2   = [(Float, Float)] -> OvertonesO
forall a. [a] -> Vector a
V.fromList ([(Float, Float)] -> OvertonesO)
-> ([Float] -> [(Float, Float)]) -> [Float] -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Float] -> [Float] -> [(Float, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([(Float, Float)] -> [Float]
forall {b} {b}. (Eq b, Eq b) => [(b, b)] -> [b]
h2 [(Float, Float)]
ys) ([Float] -> OvertonesO) -> [Float] -> OvertonesO
forall a b. (a -> b) -> a -> b
$ ([(Float, Float)] -> [Float]
h1 [(Float, Float)]
ys)
         us :: [(Float, Float)]
us = ((Float, Float) -> (Float, Float) -> Ordering)
-> [(Float, Float)] -> [(Float, Float)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Float
x1,Float
_) (Float
x2,Float
_) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x1 Float
x2) ([(Float, Float)] -> [(Float, Float)])
-> (OvertonesO -> [(Float, Float)])
-> OvertonesO
-> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> [(Float, Float)]
forall a. Vector a -> [a]
V.toList (OvertonesO -> [(Float, Float)]) -> OvertonesO -> [(Float, Float)]
forall a b. (a -> b) -> a -> b
$ Float -> OvertonesO
f Float
freq
         v3 :: OvertonesO
v3   = [(Float, Float)] -> OvertonesO
forall a. [a] -> Vector a
V.fromList ([(Float, Float)] -> OvertonesO)
-> ([Float] -> [(Float, Float)]) -> [Float] -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Float] -> [Float] -> [(Float, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([(Float, Float)] -> [Float]
forall {b} {b}. (Eq b, Eq b) => [(b, b)] -> [b]
h2 [(Float, Float)]
us) ([Float] -> OvertonesO) -> [Float] -> OvertonesO
forall a b. (a -> b) -> a -> b
$ ([(Float, Float)] -> [Float]
h1 [(Float, Float)]
us) in OvertonesO -> OvertonesO
renormF (OvertonesO -> OvertonesO)
-> ([OvertonesO] -> OvertonesO) -> [OvertonesO] -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OvertonesO] -> OvertonesO
forall a. [Vector a] -> Vector a
V.concat ([OvertonesO] -> OvertonesO) -> [OvertonesO] -> OvertonesO
forall a b. (a -> b) -> a -> b
$ [OvertonesO
v2,OvertonesO
v3]
 | Bool
otherwise = OvertonesO -> OvertonesO
renormF (OvertonesO -> OvertonesO)
-> ([OvertonesO] -> OvertonesO) -> [OvertonesO] -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OvertonesO] -> OvertonesO
forall a. [Vector a] -> Vector a
V.concat ([OvertonesO] -> OvertonesO) -> [OvertonesO] -> OvertonesO
forall a b. (a -> b) -> a -> b
$ [OvertonesO
v0, Float -> OvertonesO
f Float
freq]

-- | Can be used to produce an example of the function @gAdds@ for the 'fAddFElems'. Similar to 'gAdds01', but uses its first argument
-- to renorm the result of the 'gAdds01' so that its maximum by absolute value amplitude equals to the first argument.
gAdds02 :: Float -> OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdds02 :: Float -> OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdds02 Float
amplMax OvertonesO
v0 Float
freq = Float -> OvertonesO -> OvertonesO
renormFD Float
amplMax (OvertonesO -> OvertonesO)
-> ((Float -> OvertonesO) -> OvertonesO)
-> (Float -> OvertonesO)
-> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdds01 OvertonesO
v0 Float
freq

-- | Example of the function @gAdd@. for the 'fAddFElem'. It tries to insert the given ('Float','Float') into the less dense frequency region.
gAdd04 :: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdd04 :: (Float, Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdd04 (Float
note,Float
ampl) Float
freq Float -> OvertonesO
f 
 | OvertonesO -> Bool
forall a. Vector a -> Bool
V.null (OvertonesO -> Bool) -> (Float -> OvertonesO) -> Float -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
f (Float -> Bool) -> Float -> Bool
forall a b. (a -> b) -> a -> b
$ Float
freq = (Float, Float) -> OvertonesO
forall a. a -> Vector a
V.singleton (Float
note,Float
ampl)
 | Bool
otherwise =
    let v1 :: OvertonesO
v1 = [(Float, Float)] -> OvertonesO
forall a. [a] -> Vector a
V.fromList ([(Float, Float)] -> OvertonesO)
-> (Float -> [(Float, Float)]) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> (Float, Float) -> Ordering)
-> [(Float, Float)] -> [(Float, Float)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(Float
x1,Float
_) (Float
x2,Float
_) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Float
x1 Float
x2) ([(Float, Float)] -> [(Float, Float)])
-> (Float -> [(Float, Float)]) -> Float -> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> [(Float, Float)]
forall a. Vector a -> [a]
V.toList (OvertonesO -> [(Float, Float)])
-> (Float -> OvertonesO) -> Float -> [(Float, Float)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
f (Float -> OvertonesO) -> Float -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Float
freq
        v2 :: Vector Float
v2 = ((Float, Float) -> (Float, Float) -> Float)
-> OvertonesO -> OvertonesO -> Vector Float
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith (\(Float
x1,Float
_) (Float
x2,Float
_) -> Float
x2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x1) OvertonesO
v1 (Int -> Int -> OvertonesO -> OvertonesO
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice Int
1 (OvertonesO -> Int
forall a. Vector a -> Int
V.length OvertonesO
v1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) OvertonesO
v1)
        idxMax :: Int
idxMax = Vector Float -> Int
forall a. Ord a => Vector a -> Int
V.maxIndex Vector Float
v2
        newFreq :: Float
newFreq = ((Float, Float) -> Float
forall a b. (a, b) -> a
fst (OvertonesO -> Int -> (Float, Float)
forall a. Vector a -> Int -> a
V.unsafeIndex OvertonesO
v1 (Int
idxMax Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float, Float) -> Float
forall a b. (a, b) -> a
fst (OvertonesO -> Int -> (Float, Float)
forall a. Vector a -> Int -> a
V.unsafeIndex OvertonesO
v1 Int
idxMax)) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2 in (Float
newFreq,Float
ampl) (Float, Float) -> OvertonesO -> OvertonesO
forall a. a -> Vector a -> Vector a
`V.cons` OvertonesO
v1

-- | Example of the function @gRem@ for the 'fRemFElem'. It tries not to remove elements from the less than 6 elements 'OvertonesO' and to remove
-- all the elements in the given range with the width of the twice as many as the second 'Float' in the first argument tuple and the centre
-- in the first 'Float' in the tuple. Similar to somewhat bandreject filter but with more complex behaviour for the sound to be more complex.
gRem03 :: (Float,Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gRem03 :: (Float, Float) -> Float -> (Float -> OvertonesO) -> OvertonesO
gRem03 (Float
note,Float
halfwidth) Float
freq Float -> OvertonesO
f =
 let v1 :: OvertonesO
v1 = ((Float, Float) -> Bool) -> OvertonesO -> OvertonesO
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (\(Float
x,Float
_) -> Float -> Float -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Float -> Float
forall a. Num a => a -> a
abs (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
note)) Float
halfwidth Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT) (OvertonesO -> OvertonesO)
-> (Float -> OvertonesO) -> Float -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> OvertonesO
f (Float -> OvertonesO) -> Float -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Float
freq in
   if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (OvertonesO -> Int
forall a. Vector a -> Int
V.length OvertonesO
v1) Int
5 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT then OvertonesO -> OvertonesO
renormF (OvertonesO -> OvertonesO)
-> ((Int -> (Float, Float)) -> OvertonesO)
-> (Int -> (Float, Float))
-> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Int -> (Float, Float)) -> OvertonesO
forall a. Int -> (Int -> a) -> Vector a
V.generate Int
5 ((Int -> (Float, Float)) -> OvertonesO)
-> (Int -> (Float, Float)) -> OvertonesO
forall a b. (a -> b) -> a -> b
$ (\Int
i -> (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
note, Float
halfwidth Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3))) 
   else OvertonesO
v1