UniquenessPeriodsG.hs

-- |
-- Module      :  DobutokO.Poetry.UniquenessPeriodsG
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Helps to order the 7 or less Ukrainian words (or their concatenations) 
-- to obtain (to some extent) suitable for poetry or music text. This module 
-- provides a functionality to define more complex uniquenessPeriods functions.

module DobutokO.Poetry.UniquenessPeriodsG where

import qualified Data.Vector as V
import Data.List ((\\),nubBy)
import MMSyn7s
import Melodics.Ukrainian (convertToProperUkrainian)

-- | More complicated and longer variant of the 'uniquenessPeriods' that takes into account the second order structure of uniqueness with 'uniquenessP2' and 
-- can be therefore more fruitful (probably, it is a hypothesis itself that is needed to be tested). Is provided here as an example of the more complex 
-- \"uniqueness function\". Uses both 'uniqueness2' and 'uniqueness2n' inside and is actually their composition with some (hopefully, natural) parameter functions.
uniquenessPeriods2 :: Int -> String -> [Int]
uniquenessPeriods2 x = uniqueness2n (show7snc) (length) x . uniqueness2 (show7sn6) (uniquenessP2)

-- | Parameterized way to prepare the result that can be used with 'uniqueness2n'.
uniqueness2 :: (String -> [[String]]) -> ([[String]] -> [[String]]) -> String -> ([[String]],[String])
uniqueness2 f g xs 
 | null xs = ([],[])
 | otherwise = 
    let ys = f xs
        y2s = concat . g $ ys in (ys,y2s)

-- | Being given two functions as parameters uses them to create a longer list of 'Int' then application of only one of them. Besides, it can take into 
-- account the possible 0 and to create a non-negative list of 'Int' that can be used e. g. by 'DobutokO.Norms.splitNorm'.
uniqueness2n :: ([String] -> [Int]) -> ([String] -> Int) -> Int -> ([[String]], [String]) -> [Int]
uniqueness2n h f2 x (ys,y2s) 
 | x == 0 = fmap f2 ys ++ (0:h y2s)
 | otherwise = fmap f2 ys ++ h y2s

-- | The same as @show7s'''@, but the order of the 'String' in the first list in the tuple is preserved and corresponds to the order of 
-- the sounds in the given list of 'String'.
show7sn''' :: [String] -> ([String],String)
show7sn''' zss =
  let (xss, yss) = splitAt 68 zss
      uss = xss \\ nubBy eqSnds xss
      (wss,vss) = if null uss then (xss,[]) else (takeWhile (/= head uss) xss ++ head uss:(takeWhile (/= head uss) . tail . dropWhile (/= head uss) $ xss),
        dropWhile (/= head uss) . tail . dropWhile (/= head uss) $ xss) in 
          (filter (\x -> x /= "-" && x /= "1" && x /= "0") $ wss, listToString $ vss ++ yss)

-- | The same as @show7sn'''@, but does not concatenate the list of 'String' as the second tuple's element.
show7sn4' :: [String] -> ([String],[String])
show7sn4' zss =
  let (xss, yss) = splitAt 68 zss
      uss = xss \\ nubBy eqSnds xss
      (wss,vss) = if null uss then (xss,[]) else (takeWhile (/= head uss) xss ++ head uss:(takeWhile (/= head uss) . tail . dropWhile (/= head uss) $ xss),
        dropWhile (/= head uss) . tail . dropWhile (/= head uss) $ xss) in 
          (filter (\x -> x /= "-" && x /= "1" && x /= "0") $ wss, vss ++ yss)          

-- | The same as 'show7s5', but the the order of the 'String' in the first list in the tuple is preserved and corresponds to the order of 
-- the sounds in the given text.
show7sn5 :: String -> ([String], String)
show7sn5 = show7sn''' . V.toList . convertToProperUkrainian

-- | The same as 'show7s6', but the the order of the 'String' in the inner list is preserved and corresponds to the order of 
-- the sounds in the given text.
show7sn6 :: String -> [[String]]
show7sn6 t@(_:_) = (fst . show7sn5 $ t):(show7sn6 . snd . show7sn5 $ t)
show7sn6 _ = []

-- | Converts a list of Ukrainian 'String' each one being a Ukrainian non-silent sound representation into a list of 'Int' using recursively @show7sn4'@. 
show7snc :: [String] -> [Int]
show7snc xss = let (tss,vss) = show7sn4' xss in if null vss then [length tss] else length tss:show7snc vss

-- | Filters a given arguments so that each element 'String' in the result is filtered from the element, which is doubled the first in the next 'String' 
-- (usually, it equals to the head of it, if used as expected). Can be interpreted as a preparation to the second application of the 'uniquenessPeriods' 
-- function because it removes the elements that splitted the input into lists and can be seen as a second deeper (so, probably less significant) factor 
-- of the uniqueness phonetical structure. 
uniquenessP2 :: [[String]] -> [[String]]
uniquenessP2 (yss:ysss) 
  | null ysss = [yss]
  | otherwise = if length yss == 1 then uniquenessP2 ysss else (yss \\ [concat . take 1 . concat . take 1 $ ysss]):uniquenessP2 ysss
uniquenessP2 _ = []