{-# OPTIONS_GHC -threaded #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns #-}

-- |
-- Module      :  Composition.Sound.Functional.Elements
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@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.

module Composition.Sound.Functional.Elements (
  -- * Functions to edit OvertonesO and function f
  renormF
  , uniq
  , luniq
  , renormFD
  , sameOvertone
  , 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
--import qualified Data.Vector as V
import GHC.Arr
import qualified Data.Foldable as F
import Data.Maybe (fromJust)
import Data.Foldable.Ix
import Composition.Sound.Functional.Basics

-- | Renormalizes amplitudes for the frequencies so that the maximum one of them (if 'OvertonesO' is not []) 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 (t :: * -> *) a. Foldable t => t a -> Bool
null OvertonesO
v = []
 | Bool
otherwise =
    let v1 :: OvertonesO
v1 = ((Float, Float) -> (Float, Float) -> Ordering)
-> OvertonesO -> OvertonesO
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)) 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)
-> (OvertonesO -> (Float, Float)) -> OvertonesO -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> (Float, Float)
forall a. [a] -> a
head (OvertonesO -> Bool) -> OvertonesO -> Bool
forall a b. (a -> b) -> a -> b
$ OvertonesO
v1 then []
      else ((Float, Float) -> (Float, Float)) -> OvertonesO -> OvertonesO
forall a b. (a -> b) -> [a] -> [b]
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)
-> (OvertonesO -> (Float, Float)) -> OvertonesO -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> (Float, Float)
forall a. [a] -> a
head (OvertonesO -> Float) -> OvertonesO -> Float
forall a b. (a -> b) -> a -> b
$ OvertonesO
v1))) OvertonesO
v1

-- | Renormalizes amplitudes for the frequencies so that the maximum one of them (if 'OvertonesO' is not []) 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 (t :: * -> *) a. Foldable t => t a -> Bool
null OvertonesO
v = []
 | Bool
otherwise =
    let v1 :: OvertonesO
v1 = ((Float, Float) -> (Float, Float) -> Ordering)
-> OvertonesO -> OvertonesO
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)) 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)
-> (OvertonesO -> (Float, Float)) -> OvertonesO -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> (Float, Float)
forall a. [a] -> a
head (OvertonesO -> Bool) -> OvertonesO -> Bool
forall a b. (a -> b) -> a -> b
$ OvertonesO
v1 then []
      else ((Float, Float) -> (Float, Float)) -> OvertonesO -> OvertonesO
forall a b. (a -> b) -> [a] -> [b]
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)
-> (OvertonesO -> (Float, Float)) -> OvertonesO -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> (Float, Float)
forall a. [a] -> a
head (OvertonesO -> Float) -> OvertonesO -> Float
forall a b. (a -> b) -> a -> b
$ OvertonesO
v1))) OvertonesO
v1

-- | Predicate to check whether all tuples in the list have the same first element.
sameOvertone :: OvertonesO -> Bool
sameOvertone :: OvertonesO -> Bool
sameOvertone OvertonesO
v
 | OvertonesO -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null OvertonesO
v = Bool
False
 | Bool
otherwise = ((Float, Float) -> Bool) -> OvertonesO -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(Float
x,Float
_) -> Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
k) OvertonesO
v
     where !k :: Float
k = (Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float)
-> (OvertonesO -> (Float, Float)) -> OvertonesO -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> (Float, Float)
forall a. [a] -> a
head (OvertonesO -> Float) -> OvertonesO -> Float
forall a b. (a -> b) -> a -> b
$ OvertonesO
v

-- | @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) -> [a] -> [a]
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 (t :: * -> *) a. Foldable t => t a -> Bool
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
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 :: [Int]
v2 = Float -> [Float] -> [Int]
forall a (t :: * -> *). (Eq a, Foldable t) => a -> t a -> [Int]
findIdxsL1 Float
note ([Float] -> [Int])
-> (OvertonesO -> [Float]) -> OvertonesO -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> Float) -> OvertonesO -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Float, Float) -> Float
forall a b. (a, b) -> a
fst (OvertonesO -> [Int]) -> OvertonesO -> [Int]
forall a b. (a -> b) -> a -> b
$ OvertonesO
v1
         !ampl' :: Float
ampl' = Float
ampl Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
v2) in
          if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
v2 then (Float
note,Float
ampl) (Float, Float) -> OvertonesO -> OvertonesO
forall a. a -> [a] -> [a]
: 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))
-> [(Int, (Float, Float))] -> OvertonesO
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i, (Float
t,Float
w)) -> if Int
i Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
v2 then (Float
t,Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ampl') else (Float
t,Float
w)) ([(Int, (Float, Float))] -> OvertonesO)
-> (OvertonesO -> [(Int, (Float, Float))])
-> OvertonesO
-> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           [Int] -> OvertonesO -> [(Int, (Float, Float))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (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 list 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 (t :: * -> *) a. Foldable t => t a -> Bool
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
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 :: [Int]
v2 = Float -> [Float] -> [Int]
forall a (t :: * -> *). (Eq a, Foldable t) => a -> t a -> [Int]
findIdxsL1 Float
note ([Float] -> [Int])
-> (OvertonesO -> [Float]) -> OvertonesO -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> Float) -> OvertonesO -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Float, Float) -> Float
forall a b. (a, b) -> a
fst (OvertonesO -> [Int]) -> OvertonesO -> [Int]
forall a b. (a -> b) -> a -> b
$ OvertonesO
v1 in
       if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
v2 then OvertonesO -> OvertonesO
renormF ((Float
note,Float
ampl) (Float, Float) -> OvertonesO -> OvertonesO
forall a. a -> [a] -> [a]
: Float -> OvertonesO
f Float
freq)
       else
        let xs :: OvertonesO
xs = ((Float, Float) -> (Float, Float) -> Ordering)
-> OvertonesO -> OvertonesO
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)) OvertonesO
v1
            l :: Int
l = OvertonesO -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length OvertonesO
v1
            ys :: OvertonesO
ys = if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then (((Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float)
-> (OvertonesO -> (Float, Float)) -> OvertonesO -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> (Float, Float)
forall a. [a] -> a
head (OvertonesO -> Float) -> OvertonesO -> Float
forall a b. (a -> b) -> a -> b
$ OvertonesO
xs) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ ((Float, Float) -> Float
forall a b. (a, b) -> a
fst ((Float, Float) -> Float)
-> (OvertonesO -> (Float, Float)) -> OvertonesO -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> (Float, Float)
forall a. [a] -> a
head (OvertonesO -> (Float, Float))
-> (OvertonesO -> OvertonesO) -> OvertonesO -> (Float, Float)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> OvertonesO
forall a. [a] -> [a]
tail (OvertonesO -> Float) -> OvertonesO -> Float
forall a b. (a -> b) -> a -> b
$ OvertonesO
xs) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2,Float
ampl)(Float, Float) -> OvertonesO -> OvertonesO
forall a. a -> [a] -> [a]
:OvertonesO
xs
                 else [(Float
note,(((Float, Float) -> Float
forall a b. (a, b) -> b
snd ((Float, Float) -> Float)
-> (OvertonesO -> (Float, Float)) -> OvertonesO -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> (Float, Float)
forall a. [a] -> a
head (OvertonesO -> Float) -> OvertonesO -> Float
forall a b. (a -> b) -> a -> b
$ OvertonesO
v1) 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)
-> (OvertonesO -> (Float, Float)) -> OvertonesO -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> (Float, Float)
forall a. [a] -> a
head (OvertonesO -> Float) -> OvertonesO -> Float
forall a b. (a -> b) -> a -> b
$ OvertonesO
v1) 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
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 (t :: * -> *) a. Foldable t => t a -> Bool
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 = []
  | 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 :: [Int]
v2 = ((Float, Float) -> Bool) -> OvertonesO -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
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
         !ampl' :: Float
ampl' = Float
ampl Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
v2) in
       if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
v2 then
       if OvertonesO -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length OvertonesO
v1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5 then OvertonesO -> OvertonesO
renormF (OvertonesO -> OvertonesO)
-> (OvertonesO -> OvertonesO) -> OvertonesO -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> OvertonesO -> OvertonesO
forall a. Int -> [a] -> [a]
take (OvertonesO -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
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))
-> [(Int, (Float, Float))] -> OvertonesO
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i, (Float
t,Float
w)) -> if Int
i Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
v2 then (Float
t,Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
ampl') else (Float
t,Float
w)) ([(Int, (Float, Float))] -> OvertonesO)
-> (OvertonesO -> [(Int, (Float, Float))])
-> OvertonesO
-> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         [Int] -> OvertonesO -> [(Int, (Float, Float))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (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 list 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 list 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 [[Float]
v11,[Float]
v21] = (OvertonesO -> [Float]) -> [OvertonesO] -> [[Float]]
forall a b. (a -> b) -> [a] -> [b]
map (((Float, Float) -> Float) -> OvertonesO -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Float, Float) -> Float
forall a b. (a, b) -> a
fst) [OvertonesO
v1,OvertonesO
v2]
      v22 :: [Float]
v22 = (Float -> Bool) -> [Float] -> [Float]
forall a. (a -> Bool) -> [a] -> [a]
filter (Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float]
v11) [Float]
v21 in
        if [Float] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Float]
v22 then Bool
False
        else
          let v12 :: [Float]
v12 = (Float -> Bool) -> [Float] -> [Float]
forall a. (a -> Bool) -> [a] -> [a]
filter (Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Float]
v21) [Float]
v11
              [[Float]
v13,[Float]
v23] = ([Float] -> [Float]) -> [[Float]] -> [[Float]]
forall a b. (a -> b) -> [a] -> [b]
map ([Float] -> [Float]
forall a. Eq a => [a] -> [a]
uniq ([Float] -> [Float]) -> ([Float] -> [Float]) -> [Float] -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Float] -> [Float]
forall a. Ord a => [a] -> [a]
sort) [[Float]
v12,[Float]
v22]
              [Int
l1,Int
l2]  = ([Float] -> Int) -> [[Float]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Float]
v13,[Float]
v23] in
                ([Float] -> Int
forall a. Eq a => [a] -> Int
luniq ([Float] -> Int) -> ([[Float]] -> [Float]) -> [[Float]] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Float] -> [Float]
forall a. Ord a => [a] -> [a]
sort ([Float] -> [Float])
-> ([[Float]] -> [Float]) -> [[Float]] -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Float]] -> [Float]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Float]] -> Int) -> [[Float]] -> Int
forall a b. (a -> b) -> a -> b
$ [[Float]
v13,[Float]
v23]) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l2)

uniq :: (Eq a) => [a] -> [a]
uniq :: [a] -> [a]
uniq = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
f [a]
forall a. [a]
v
  where v :: [a]
v = []
        f :: a -> [a] -> [a]
f a
x [a]
xs
          | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> a
forall a. [a] -> a
head [a]
xs = [a]
xs
          | Bool
otherwise = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs

luniq :: (Eq a) => [a] -> Int
luniq :: [a] -> Int
luniq [a]
xs = ([a], Int) -> Int
forall a b. (a, b) -> b
snd (([a], Int) -> Int) -> ([a] -> ([a], Int)) -> [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ([a], Int) -> ([a], Int)) -> ([a], Int) -> [a] -> ([a], Int)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> ([a], Int) -> ([a], Int)
forall a a. (Eq a, Num a) => a -> ([a], a) -> ([a], a)
f ([a], Int)
forall a. ([a], Int)
v ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ [a]
xs
  where v :: ([a], Int)
v = ([],Int
0)
        f :: a -> ([a], a) -> ([a], a)
f a
x ([a]
xs,a
i)
          | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> a
forall a. [a] -> a
head [a]
xs = ([a]
xs, a
i)
          | Bool
otherwise = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs, a
i a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)

-- | 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) -> [a] -> [a]
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 (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
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 (t :: * -> *) a. Foldable t => t a -> Bool
null OvertonesO
v22 then Bool
False
        else
          let v12 :: OvertonesO
v12 = ((Float, Float) -> Bool) -> OvertonesO -> OvertonesO
forall a. (a -> Bool) -> [a] -> [a]
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 (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
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 => [a] -> [a]
uniq (OvertonesO -> OvertonesO)
-> (OvertonesO -> OvertonesO) -> OvertonesO -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> OvertonesO
forall a. Ord a => [a] -> [a]
sort) [OvertonesO
v12,OvertonesO
v22]
              [Int
l1,Int
l2]  = (OvertonesO -> Int) -> [OvertonesO] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map OvertonesO -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [OvertonesO
v13,OvertonesO
v23] in (OvertonesO -> Int
forall a. Eq a => [a] -> Int
luniq (OvertonesO -> Int)
-> ([OvertonesO] -> OvertonesO) -> [OvertonesO] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> OvertonesO
forall a. Ord a => [a] -> [a]
sort (OvertonesO -> OvertonesO)
-> ([OvertonesO] -> OvertonesO) -> [OvertonesO] -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OvertonesO] -> OvertonesO
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([OvertonesO] -> Int) -> [OvertonesO] -> Int
forall a b. (a -> b) -> a -> b
$ [OvertonesO
v13,OvertonesO
v23]) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l2)

-- | 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 (t :: * -> *) a. Foldable t => t a -> Bool
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 :: OvertonesO
ys = ((Float, Float) -> (Float, Float) -> Ordering)
-> OvertonesO -> OvertonesO
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) OvertonesO
v0
         h :: [a] -> [[a]]
h [a]
ys
          | [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. [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. [a] -> a
head [a]
ys)) [a]
ys)
         h1 :: OvertonesO -> [Float]
h1 = (OvertonesO -> Float) -> [OvertonesO] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (\OvertonesO
zs -> ([Float] -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Float] -> Float)
-> (OvertonesO -> [Float]) -> OvertonesO -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Float, Float) -> Float) -> OvertonesO -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Float, Float) -> Float
forall a b. (a, b) -> b
snd (OvertonesO -> Float) -> OvertonesO -> Float
forall a b. (a -> b) -> a -> b
$ OvertonesO
zs) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (OvertonesO -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length OvertonesO
zs)) ([OvertonesO] -> [Float])
-> (OvertonesO -> [OvertonesO]) -> OvertonesO -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OvertonesO -> [OvertonesO]
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. [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 b. [a] -> [b] -> [(a, b)]
zip (OvertonesO -> [Float]
forall b b. (Eq b, Eq b) => [(b, b)] -> [b]
h2 OvertonesO
ys) (OvertonesO -> [Float]
h1 OvertonesO
ys)
         us :: OvertonesO
us = ((Float, Float) -> (Float, Float) -> Ordering)
-> OvertonesO -> OvertonesO
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) (OvertonesO -> OvertonesO) -> OvertonesO -> OvertonesO
forall a b. (a -> b) -> a -> b
$ Float -> OvertonesO
f Float
freq
         v3 :: OvertonesO
v3   = [Float] -> [Float] -> OvertonesO
forall a b. [a] -> [b] -> [(a, b)]
zip (OvertonesO -> [Float]
forall b b. (Eq b, Eq b) => [(b, b)] -> [b]
h2 OvertonesO
us) (OvertonesO -> [Float]
h1 OvertonesO
us) in OvertonesO -> OvertonesO
renormF (OvertonesO -> OvertonesO)
-> ([OvertonesO] -> OvertonesO) -> [OvertonesO] -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OvertonesO] -> OvertonesO
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
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 (t :: * -> *) a. Foldable t => t [a] -> [a]
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 (t :: * -> *) a. Foldable t => t a -> Bool
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
note,Float
ampl)]
 | Bool
otherwise =
    let v1 :: OvertonesO
v1 = ((Float, Float) -> (Float, Float) -> Ordering)
-> OvertonesO -> OvertonesO
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) (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
        v2 :: [Float]
v2 = ((Float, Float) -> (Float, Float) -> Float)
-> OvertonesO -> OvertonesO -> [Float]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
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. Eq a => Int -> Int -> [a] -> [a]
s2L Int
1 (OvertonesO -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length OvertonesO
v1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) OvertonesO
v1)
        !mx :: Float
mx = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float]
v2
        idxMax :: Int
idxMax = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> ([Float] -> Maybe Int) -> [Float] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Bool) -> [Float] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
mx) ([Float] -> Int) -> [Float] -> Int
forall a b. (a -> b) -> a -> b
$ [Float]
v2
        newFreq :: Float
newFreq = ((Float, Float) -> Float
forall a b. (a, b) -> a
fst (OvertonesO
v1 OvertonesO -> Int -> (Float, Float)
forall a. [a] -> Int -> a
!! (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
v1 OvertonesO -> Int -> (Float, Float)
forall a. [a] -> Int -> a
!! 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 -> [a] -> [a]
: 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) -> [a] -> [a]
filter (\(Float
x,Float
_) -> Float -> Float
forall a. Num a => a -> a
abs (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
note) Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
halfwidth) (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 OvertonesO -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length OvertonesO
v1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
5 then OvertonesO -> OvertonesO
renormF (OvertonesO -> OvertonesO)
-> ([Integer] -> OvertonesO) -> [Integer] -> OvertonesO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> (Float, Float)) -> [Integer] -> OvertonesO
forall a b. (a -> b) -> [a] -> [b]
map (\Integer
i -> (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
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
/ Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
3))) ([Integer] -> OvertonesO) -> [Integer] -> OvertonesO
forall a b. (a -> b) -> a -> b
$ [Integer
0..Integer
4]
   else OvertonesO
v1