-- |
-- Module      :  Composition.Sound.Functional.Split
-- 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.

{-# OPTIONS_GHC -threaded #-}

module Composition.Sound.Functional.Split (
  -- * Splitting and concatenating OvertonesO
  splitO
  , splitO2
  , overConcat
  -- ** Generalization of the previous ones splitting functions
  , splitHelp1
  , splitHelp2
  , splitOG1
  , splitOG2
  , splitOG12
  , splitOG12S
  , splitOG22
  , splitOG22S
) where

import CaseBi.Arr (getBFstL')
import Data.Char (isAsciiLower)
import Data.List (sortBy)
import GHC.Arr
import Data.Foldable.Ix
import qualified Data.Foldable as F
import Composition.Sound.Functional.Basics


-- | Splits (with addition of the new overtones) a given 'OvertonesO' into a number @n@ (specified by the first 'Int' argument) of 'OvertonesO' 
-- (represented finally as a list of them respectively) so that all except the first @n@ greatest by the absolute value of the amplitude 
-- tuples of Floats are considered overtones for the greatest by the absolute value one in the given 'OvertonesO' and all the next @n - 1@ 
-- are treated as the greatest by the absolute value and each of them produces the similar by the @f :: Float -> OvertonesO@ function overtones.
-- 
-- It is expected to obtain by such a conversion a splitted one sound into several simultaneous similar ones with different heights. 
-- To provide a rich result, the given first argument must be strictly less than the length of the given 'OvertonesO' minus one.
splitO :: Int -> OvertonesO -> [OvertonesO]
splitO n v0 
 | length v0 > (n + 1) = 
    let v1 = sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) v0
        (x0, y0) = head v1
        v2 = s2L 1 (n - 1) v1
        v31 = map (\t -> (fst t) / x0) v2
        v32 = map (\t -> (snd t) / y0) v2
        v3 = zip v31 v32
        f1Tup (t1, w2) = map (\(i, rr) -> (fst rr * t1, snd rr * w2)) . zip [0..] $ v3
          in map f1Tup . take n $ v1
 | otherwise = [v0]

-- | Splits (with addition of the new overtones) a given 'OvertonesO' into a number of 'OvertonesO' (represented finally as a 'Array' 'Int' of them repsectively) 
-- so that it intermediately uses a special function before applying the \"similarization\" splitting function. Is a generalization of the 'splitO', 
-- which can be considered a 'splitO2' with a first command line argument equals to 'id'.
-- 
-- It is expected to obtain by such a conversion a splitted one sound into several simultaneous similar (less or more, depending on @h :: OvertonesO -> OvertonesO@) 
-- ones with different heights. To provide a rich result, the given first argument must be strictly less than the length of the given 'OvertonesO' minus one.
splitO2 :: (OvertonesO -> OvertonesO) -> Int -> OvertonesO -> [OvertonesO]
splitO2 h n v0
 | length v0 > (n + 1) = 
    let v1 = sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) v0
        (x0, y0) = head v1
        v2 = s2L 1 (n - 1) v1
        v31 = map (\t -> (fst t) / x0) v2
        v32 = map (\t -> (snd t) / y0) v2
        v3 = zip v31 v32
        f1Tup (t1, w2) = map (\(i, rr) -> (fst rr * t1, snd rr * w2)) . zip [0..] $ v3
          in map f1Tup (h . take n $ v1)
 | otherwise = [v0]

-- | Generalized variant of the 'splitO' with the different splitting variants depending on the first two ASCII lower case letters in the 'String' argument.
splitOG1 :: String -> Int -> OvertonesO -> [OvertonesO]
splitOG1 xs n v0 
 | length v0 > (n + 1) = 
    let c1s = take 2 . filter isAsciiLower $ xs
        v1 = sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) v0
        (x0, y0) = head v1 in
          case c1s of
            "ab" -> let (k1,k2,k3,k4) = (n - 1,length v0 - n,n - 1,length v0 - n) in splitHelp1 k1 k2 k3 k4 v1 (x0,y0) 
            "ac" -> let (k1,k2,k3,k4) = (1,n - 1,n - 1,length v0 - n) in splitHelp1 k1 k2 k3 k4 v1 (x0,y0) 
            "ad" -> let (k1,k2,k3,k4) = (n - 1,length v0 - n,0,n) in splitHelp1 k1 k2 k3 k4 v1 (x0,y0) 
            _    -> let (k1,k2,k3,k4) = (1,n - 1,0,n) in splitHelp1 k1 k2 k3 k4 v1 (x0,y0) 
 | otherwise = [v0]

-- | Auxiliary function that is used inside 'splitOG1'.
splitHelp1 :: Int -> Int -> Int -> Int -> [(Float, Float)] -> (Float,Float) -> [OvertonesO]
splitHelp1 x1 x2 x3 x4 v0 (y5,y6) = 
  let v2 = s2L x1 x2 v0
      v31 = map (\t -> (fst t) / y5) v2
      v32 = map (\t -> (snd t) / y6) v2
      v3 = zip v31 v32
      f1Tup (t1, w2) = map (\(i, rr) -> (fst rr * t1, snd rr * w2)) . zip [0..] $ v3 in map f1Tup (s2L x3 x4 v0)

-- | Auxiliary function that is used inside 'splitOG2'.
splitHelp2 :: (OvertonesO -> OvertonesO) -> Int -> Int -> Int -> Int -> [(Float, Float)] -> (Float,Float) -> [OvertonesO]
splitHelp2 h1 x1 x2 x3 x4 v0 (y5,y6) = 
  let v2 = s2L x1 x2 v0
      v31 = map (\t -> (fst t) / y5) v2
      v32 = map (\t -> (snd t) / y6) v2
      v3 = zip v31 v32
      f1Tup (t1, w2) = map (\(i, rr) -> (fst rr * t1, snd rr * w2)) . zip [0..] $ v3 in map f1Tup (h1 . s2L x3 x4 $ v0)        

-- | Generalized variant of the 'splitO2' with the different splitting variants depending on the first two ASCII lower case letters in the 'String' argument.
splitOG2 :: (OvertonesO -> OvertonesO) -> String -> Int -> [(Float, Float)] -> [OvertonesO]
splitOG2 h xs n v0
 | length v0 > (n + 1) = 
    let c1s = take 2 . filter isAsciiLower $ xs
        v1 = sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) v0
        (x0, y0) = head v1 in
          case c1s of
            "ab" -> let (k1,k2,k3,k4) = (n - 1,length v0 - n,n - 1,length v0 - n) in splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) 
            "ac" -> let (k1,k2,k3,k4) = (1,n - 1,n - 1,length v0 - n) in splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) 
            "ad" -> let (k1,k2,k3,k4) = (n - 1,length v0 - n,0,n) in splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) 
            _    -> let (k1,k2,k3,k4) = (1,n - 1,0,n) in splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) 
 | otherwise = [v0]

-- | Generalized variant of the 'splitOG1' with a possibility to specify a default value for splitting parameters as the first argument 
-- @(Int,Int,Int,Int)@ and the sorted by the first element in the tuple (actually a 'String') in ascending order list (the second one). 
-- Each 'String' in the list must be unique and consist of lowercase ASCII letters.
splitOG12 :: (Int,Int,Int,Int) -> [(String,Int -> [(Float, Float)] -> (Int,Int,Int,Int))] -> String -> Int -> [(Float, Float)] -> [OvertonesO]
splitOG12 (x1,x2,x3,x4) vf xs n v0
 | length v0 > (n + 1) && not (null vf) = 
    let c1s = filter isAsciiLower xs
        v1 = sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) v0
        (x0, y0) = head v1 in let (k1,k2,k3,k4) = getBFstL' (x1,x2,x3,x4) (map (\(ys,g) -> (ys,g n v1)) vf) c1s in 
          splitHelp1 k1 k2 k3 k4 v1 (x0,y0) 
 | otherwise = [v0]    

-- | Variant of the 'splitOG12' applied to the unsorted second argument. It sorts it internally. If you specify the already sorted second argument 
-- then it is better to use 'splitOG12'. Each 'String' in the list must be unique and consist of lowercase ASCII letters.
splitOG12S :: (Int,Int,Int,Int) -> [(String,Int -> [(Float, Float)] -> (Int,Int,Int,Int))] -> String -> Int -> [(Float, Float)] -> [OvertonesO]
splitOG12S (x1,x2,x3,x4) vf xs n v0
 | length v0 > (n + 1) && not (null vf) = 
    let c1s = filter isAsciiLower xs
        v1 = sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) v0
        v2 = sortBy (\(x1s,_) (x2s,_) -> compare x1s x2s) vf
        (x0, y0) = head v1 in let (k1,k2,k3,k4) = getBFstL' (x1,x2,x3,x4) (map (\(ys,g) -> (ys,g n v1)) v2) c1s in 
          splitHelp1 k1 k2 k3 k4 v1 (x0,y0) 
 | otherwise = [v0]

-- | Generalized variant of the 'splitOG2' with a possibility to specify a default value for splitting parameters as the first argument 
-- @(Int,Int,Int,Int)@ and the sorted by the first element in the tuple (actually a 'String') in ascending order list (the second one). 
-- Each 'String' in the list must be unique and consist of lowercase ASCII letters.
splitOG22 :: (Int,Int,Int,Int) -> [(String,Int -> [(Float, Float)] -> (Int,Int,Int,Int))] -> (OvertonesO -> OvertonesO) -> String -> Int -> 
  [(Float, Float)] -> [OvertonesO]
splitOG22 (x1,x2,x3,x4) vf h xs n v0
 | length v0 > (n + 1) && not (null vf) = 
    let c1s = filter isAsciiLower xs
        v1 = sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) v0
        (x0, y0) = head v1 in let (k1,k2,k3,k4) = getBFstL' (x1,x2,x3,x4) (map (\(ys,g) -> (ys,g n v1)) vf) c1s in 
          splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) 
 | otherwise = [v0]    
 
-- | Variant of the 'splitOG22' applied to the unsorted second argument. It sorts it internally. If you specify the already sorted second argument 
-- then it is better to use 'splitOG22'. Each 'String' in the list must be unique and consist of lowercase ASCII letters.
splitOG22S :: (Int,Int,Int,Int) -> [(String,Int -> [(Float, Float)] -> (Int,Int,Int,Int))] -> (OvertonesO -> OvertonesO) -> String -> Int -> 
  [(Float, Float)] -> [OvertonesO]
splitOG22S (x1,x2,x3,x4) vf h xs n v0
 | length v0 > (n + 1) && not (null vf) = 
    let c1s = filter isAsciiLower xs
        v1 = sortBy (\(x1,_) (x2,_) -> compare (abs x2) (abs x1)) v0
        v2 = sortBy (\(x1s,_) (x2s,_) -> compare x1s x2s) vf
        (x0, y0) = head v1 in let (k1,k2,k3,k4) = getBFstL' (x1,x2,x3,x4) (map (\(ys,g) -> (ys,g n v1)) v2) c1s in 
          splitHelp2 h k1 k2 k3 k4 v1 (x0,y0) 
 | otherwise = [v0]    

-- | Concatenates a list of 'OvertonesO' into a single 'OvertonesO'. Can be easily used with 'splitO'.
overConcat :: [OvertonesO] -> OvertonesO
overConcat = concat