-- | -- 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. {-# LANGUAGE CPP #-} module DobutokO.Poetry.UniquenessPeriodsG where #ifdef __GLASGOW_HASKELL__ #if __GLASGOW_HASKELL__>=710 /* code that applies only to GHC 7.10.* and higher versions */ import GHC.Base (mconcat) #endif #endif import qualified Data.Vector as V import Data.List ((\\),nubBy) import MMSyn7s import Melodics.Ukrainian (convertToProperUkrainian) #ifdef __GLASGOW_HASKELL__ #if __GLASGOW_HASKELL__==708 /* code that applies only to GHC 7.8.* */ mconcat = concat #endif #endif -- | More complicated and longer variant of the 'MMSyn7s.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 = mconcat . 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 'MMSyn7s.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 _ = []