{-# 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 v
 | null v = []
 | otherwise =
    let v1 = sortBy (\(_,y1) (_,y2)-> compare (abs y2) (abs y1)) v in
      if (\(_,y) -> y == 0.0) . head $ v1 then []
      else map (\(x,y) -> (x, y / (snd . head $ v1))) 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 ampl0 v
 | null v = []
 | otherwise =
    let v1 = sortBy (\(_,y1) (_,y2)-> compare (abs y2) (abs y1)) v in
      if (\(_,y) -> y == 0.0) . head $ v1 then []
      else map (\(x,y) -> (x, ampl0 * y / (snd . head $ v1))) v1

-- | Predicate to check whether all tuples in the list have the same first element.
sameOvertone :: OvertonesO -> Bool
sameOvertone v
 | null v = False
 | otherwise = all (\(x,_) -> x == k) v
     where !k = fst . head $ 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 freq (noteN0,amplN0) f g = g (noteN0,amplN0) (f 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 freq (noteN0,amplN0) f g = g (noteN0,amplN0) . filter (\(x,_) -> x == noteN0) $ f 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 (noteN, amplN) f gAdd t = gAdd (noteN, amplN) t 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 (noteN, amplN) f gRem t = gRem (noteN, amplN) t 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 (noteN, amplN) freq h f t = (h freq) (noteN, amplN) t 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 (note,ampl) freq f 
 | null . f $ freq = [(note,ampl)]
 | otherwise =
    let v1 = renormF . f $ freq in
     let v2 = findIdxsL1 note . map fst $ v1
         !ampl' = ampl / fromIntegral (length v2) in
          if null v2 then (note,ampl) : f freq
          else renormF . map (\(i, (t,w)) -> if i `elem` v2 then (t,w + ampl') else (t,w)) .
           zip [0..] $ 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 amplMax (note,ampl) freq = renormFD amplMax . gAdd01 (note,ampl) 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 (note,ampl) freq f 
 | null . f $ freq = [(note,ampl)]
 | otherwise =
    let v1 = renormF . f $ freq in
     let v2 = findIdxsL1 note . map fst $ v1 in
       if null v2 then renormF ((note,ampl) : f freq)
       else
        let xs = sortBy (\(x1,_) (x2,_)-> compare (abs x2) (abs x1)) v1
            l = length v1
            ys = if l > 1 then ((fst . head $ xs) + (fst . head . tail $ xs) / 2,ampl):xs
                 else [(note,((snd . head $ v1) + ampl) / 2),(2 * note,(abs ((snd . head $ v1) - ampl)) / 2)] in renormF 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 (note,ampl) freq f
  | null . f $ freq = []
  | otherwise =
     let v1 = renormF . f $ freq in
     let v2 = findIndices (\(x,y) -> x == note && y == ampl) v1
         !ampl' = ampl / fromIntegral (length v2) in
       if null v2 then
       if length v1 > 5 then renormF . take (length v1 - 1) $ v1
       else v1
       else renormF . map (\(i, (t,w)) -> if i `elem` v2 then (t,w - ampl') else (t,w)) .
         zip [0..] $ 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 amplMax (note,ampl) freq = renormFD amplMax . gAdd01 (note,ampl) 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 v f gAdds t = gAdds v t 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 v f gRems t = gRems v t 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 v freq h f t = (h freq) v t 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 v1 v2 =
  let [v11,v21] = map (map fst) [v1,v2]
      v22 = filter (<= maximum v11) v21 in
        if null v22 then False
        else
          let v12 = filter (>= minimum v21) v11
              [v13,v23] = map (uniq . sort) [v12,v22]
              [l1,l2]  = map length [v13,v23] in
                (luniq . sort . concat $ [v13,v23]) < (l1 + l2)

uniq :: (Eq a) => [a] -> [a]
uniq = foldr f v
  where v = []
        f x xs
          | x == head xs = xs
          | otherwise = x:xs

luniq :: (Eq a) => [a] -> Int
luniq xs = snd . foldr f v $ xs
  where v = ([],0)
        f x (xs,i)
          | x == head xs = (xs, i)
          | otherwise = (x:xs, i + 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 v1 v2 =
  let v22 = filter (\(x,_) -> x <= fst (maximumBy (\(x1,_) (t,_) -> compare x1 t) v1)) v2 in
        if null v22 then False
        else
          let v12 = filter (\(x,_) -> x >= fst (minimumBy (\(x1,_) (t,_) -> compare x1 t) v2)) v1
              [v13,v23] = map (uniq . sort) [v12,v22]
              [l1,l2]  = map length [v13,v23] in (luniq . sort . concat $ [v13,v23]) < (l1 + l2)

-- | Example of the function @gAdds@ for the 'fAddFElems'. 
gAdds01 :: OvertonesO -> Float -> (Float -> OvertonesO) -> OvertonesO
gAdds01 v0 freq f 
 | null . f $ freq = v0
 | freqsOverlapOvers v0 (f freq) =
     let ys = sortBy (\(x1,_) (x2,_) -> compare x1 x2) v0
         h ys
          | null ys = []
          | otherwise = (takeWhile (not . (/= head ys)) ys):h (dropWhile (not . (/= head ys)) ys)
         h1 = map (\zs -> (sum . map snd $ zs) / fromIntegral (length zs)) . h
         h2 ys = map (fst . head) (h ys)
         v2   = zip (h2 ys) (h1 ys)
         us = sortBy (\(x1,_) (x2,_) -> compare x1 x2) $ f freq
         v3   = zip (h2 us) (h1 us) in renormF . concat $ [v2,v3]
 | otherwise = renormF . concat $ [v0, f 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 amplMax v0 freq = renormFD amplMax . gAdds01 v0 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 (note,ampl) freq f 
 | null . f $ freq = [(note,ampl)]
 | otherwise =
    let v1 = sortBy (\(x1,_) (x2,_) -> compare x1 x2) . f $ freq
        v2 = zipWith (\(x1,_) (x2,_) -> x2 - x1) v1 (s2L 1 (length v1 - 1) v1)
        !mx = maximum v2
        idxMax = fromJust . findIndex (== mx) $ v2
        newFreq = (fst (v1 !! (idxMax + 1)) + fst (v1 !! idxMax)) / 2 in (newFreq,ampl) : 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 (note,halfwidth) freq f =
 let v1 = filter (\(x,_) -> abs (x - note) <= halfwidth) . f $ freq in
   if length v1 <= 5 then renormF . map (\i -> (fromIntegral (i + 1) * note, halfwidth / fromIntegral (i + 3))) $ [0..4]
   else v1