{-# OPTIONS_GHC -threaded -rtsopts #-} {-# OPTIONS_HADDOCK show-extensions #-} {-# LANGUAGE BangPatterns, FlexibleContexts #-} -- | -- Module : Phonetic.Languages.GetTextualInfo -- Copyright : (c) OleksandrZhabenko 2020-2021 -- License : MIT -- Stability : Experimental -- Maintainer : olexandr543@yahoo.com -- -- Library module that contains functions used by the propertiesTextG3 -- executable. module Phonetic.Languages.GetTextualInfo ( generalProc , linesFromArgs1 , linesFromArgsG , getData3 , process1Line ) where import Data.SubG hiding (takeWhile,dropWhile) import System.IO import Control.Concurrent import Control.Exception import Control.Parallel.Strategies import Data.Maybe (fromMaybe) import Data.List (sort) import Text.Read (readMaybe) import GHC.Arr import Melodics.ByteString.Ukrainian.Arr import Phonetic.Languages.Ukrainian.PrepareText import Numeric (showFFloat) import Phonetic.Languages.Filters import Data.Char (isAlpha) import Data.Statistics.RulesIntervalsPlus import Data.MinMax.Preconditions import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2 import Phonetic.Languages.Simplified.StrictVG.Base import Phonetic.Languages.Permutations.Arr import Phonetic.Languages.Permutations.ArrMini import Phonetic.Languages.Simplified.DataG.Base import Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2 import Languages.UniquenessPeriods.Array.Constraints.Encoded import Phonetic.Languages.Simplified.SimpleConstraints import Phonetic.Languages.Common import qualified Languages.Phonetic.Ukrainian.Syllable.Arr as S (UZPP2) import Phonetic.Languages.Ukrainian.PrepareText (prepareGrowTextMN, prepareTuneTextMN,isSpC,isUkrainianL) import Phonetic.Languages.Simplified.Array.Ukrainian.ReadProperties {-| @ since 0.5.0.0 -- The meaning of the first command line argument (and 'Coeffs2' here everywhere in the module) depends on the 'String' argument -- whether it starts with \'w\', \'x\' or otherwise. In the first case it represents the k1 and k2 coefficients (default ones equal to 2.0 and 0.125) for the functions from the Rhythmicity.TwoFourth module. Otherwise, it is used for the functions to specify the level of emphasizing the two-based and three-based periods (the default values here are 1.0 both). @ since 0.6.0.0 -- There is also the possibility to use \'line growing\' that is to use the 'prepereGrowTextMN' function with the 'Int' arguments from the first argument tuple. This allows to rearrange the given text and then to rewrite it. Besides there are new lines of the arguments for the 'String' argument that can begin with \"c\", \"s\", \"t\", \"u\", \"v\", \"C\", \"N\", \"S\", \"T\", \"U\", \"V\", \"W\", \"X\", \"Y\" and \"Z\" letters. For more information, please, refer to the 'Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2.rhythmicity'. -} generalProc :: FilePath -- ^ Whether to use the own provided durations from the file specified here. Uses the 'readSyllableDurations' function. -> Bool -- ^ Whether to use just pairwise permutations (if 'True') or the whole possible set of them (otherwise). The first corresponds to the quick evaluation mode. -> (Int,Int) -> Bool -> [String] -> [String] -> Coeffs2 -> Coeffs2 -> FilePath -> String -> Int -> Int -> String -> IO () generalProc fileDu pairwisePermutations (gr1,gr2) lstW multiples2 lInes coeffs coeffsWX file gzS printLine toOneLine choice | null lInes = do syllableDurationsDs <- readSyllableDurations fileDu contents <- readFile file let !flines | gr1 == 0 = fLinesN (if pairwisePermutations then 10 else 7) toOneLine contents | otherwise = prepareGrowTextMN gr1 gr2 . unlines . fLinesN (if pairwisePermutations then 10 else 7) toOneLine $ contents getData3 syllableDurationsDs pairwisePermutations lstW coeffs coeffsWX (getIntervalsNS lstW gzS flines) printLine choice multiples2 flines | otherwise = do syllableDurationsDs <- readSyllableDurations fileDu contents <- readFile file let !flines = (if gr1 == 0 then id else prepareGrowTextMN gr1 gr2 . unlines) . fLinesN (if pairwisePermutations then 10 else 7) toOneLine . unlines . linesFromArgsG lInes . fLinesN (if pairwisePermutations then 10 else 7) 0 $ contents getData3 syllableDurationsDs pairwisePermutations lstW coeffs coeffsWX (getIntervalsNS lstW gzS flines) printLine choice multiples2 flines linesFromArgs1 :: Int -> String -> [String] -> [String] linesFromArgs1 n xs yss = let (!ys,!zs) = (\(x,z) -> (x, drop 1 z)) . break (== ':') $ xs !ts = sort . map (min n . abs) $ [fromMaybe 1 (readMaybe ys::Maybe Int), fromMaybe n (readMaybe zs::Maybe Int)] in drop (head ts - 1) . take (last ts) $ yss linesFromArgsG :: [String] -> [String] -> [String] linesFromArgsG xss yss = let n = length yss in concatMap (\ts -> linesFromArgs1 n ts yss) xss getData3 :: [[[[S.UZPP2]]] -> [[Double]]] -- ^ Whether to use the own provided durations. -> Bool -- ^ Whether to use just pairwise permutations (if 'True') or the whole possible set of them (otherwise). The first corresponds to the quick evaluation mode. -> Bool -> Coeffs2 -> Coeffs2 -> Int -> Int -> String -> [String] -> [String] -> IO () getData3 syllableDurationsDs pairwisePermutations lstW coeffs coeffsWX gz printLine choice multiples3 zss = let !permsV4 = if pairwisePermutations then genPairwisePermutationsArrLN 10 else genPermutationsArrL in putStrLn (replicate (length multiples3 + 1) '\t' `mappend` show gz) >> mapM_ (process1Line syllableDurationsDs lstW coeffs coeffsWX gz printLine choice multiples3 permsV4) zss process1Line :: [[[[S.UZPP2]]] -> [[Double]]] -- ^ Whether to use the own provided durations. -> Bool -> Coeffs2 -> Coeffs2 -> Int -> Int -> String -> [String] -> Array Int [Array Int Int] -> String -> IO () process1Line syllableDurationsDs lstW coeffs coeffsWX gz printLine choice multiples4 !permsV50 v | null multiples4 = bracket (do { myThread <- forkIO (do let !v2 = words v !l2 = length v2 - 2 if l2 >= (if lstW then 1 else 0) then do let !permsV5 = decodeConstraint1 (fromMaybe (E 1) . readMaybeECG (l2 + 1) . showB (l2 + 2) $ lstW) . unsafeAt permsV50 $ l2 ((!minE,!maxE),!data2) = runEval (parTuple2 rpar rpar (minMax11C . map (toTransPropertiesF' (if take 1 choice == "x" || take 1 choice == "w" || (take 1 choice == "H" && (drop 1 (take 2 choice) `elem` ["w","x"])) then chooseMax syllableDurationsDs id coeffsWX choice else chooseMax syllableDurationsDs id coeffs choice)) . uniquenessVariants2GNBL ' ' id id id permsV5 $ v2, toTransPropertiesF' (if take 1 choice == "x" || take 1 choice == "w" then chooseMax syllableDurationsDs id coeffsWX choice else chooseMax syllableDurationsDs id coeffs choice) . unwords . subG " 01-" $ v)) (!wordsN,!intervalN) = (l2 + 2, intervalNRealFrac minE maxE gz data2) !ratio = if maxE == 0.0 then 0.0 else 2.0 * data2 / (minE + maxE) hPutStr stdout . showFFloat (precChoice choice) minE $ "\t" hPutStr stdout . showFFloat (precChoice choice) data2 $ "\t" hPutStr stdout . showFFloat (precChoice choice) maxE $ "\t" hPutStr stdout . showFFloat (Just 4) (data2 / minE) $ "\t" hPutStr stdout . showFFloat (Just 4) (maxE / minE) $ "\t" hPutStr stdout . showFFloat (Just 4) (maxE / data2) $ "\t" hPutStr stdout . showFFloat (Just 8) ratio $ "\t" hPutStr stdout ('\t':show (wordsN::Int)) hPutStr stdout ('\t':show (intervalN::Int)) hPutStrLn stdout (if printLine == 1 then '\t':v else "") else putStrLn (replicate (length multiples4) '\t' ++ if printLine == 1 then '\t':v else "")) ; return myThread }) (killThread) (\_ -> putStr "") | otherwise = bracket (do { myThread <- forkIO (do let !v2 = words v !l2 = length v2 - 2 if l2 >= (if lstW then 1 else 0) then do let !permsV5 = decodeConstraint1 (fromMaybe (E 1) . readMaybeECG (l2 + 1) . showB (l2 + 2) $ lstW) . unsafeAt permsV50 $ l2 rs = parMap rpar (\choiceMMs -> (minMax11C . map (toTransPropertiesF' (if take 1 choiceMMs == "x" || take 1 choiceMMs == "w" || (take 1 choice == "H" && (drop 1 (take 2 choice) `elem` ["w","x"])) then chooseMax syllableDurationsDs id coeffsWX choiceMMs else chooseMax syllableDurationsDs id coeffs choiceMMs)) . uniquenessVariants2GNBL ' ' id id id permsV5 $ v2, toTransPropertiesF' (if take 1 choiceMMs == "x" || take 1 choiceMMs == "w" || (take 1 choice == "H" && (drop 1 (take 2 choice) `elem` ["w","x"])) then chooseMax syllableDurationsDs id coeffsWX choiceMMs else chooseMax syllableDurationsDs id coeffs choiceMMs) . unwords . subG " 01-" $ v,gz)) multiples4 (!wordsN,!intervalNs) = (l2 + 2, map (\((!x,!y),!z,!t) -> intervalNRealFrac x y t z) rs) in do hPutStr stdout (show (wordsN::Int)) mapM_ (\i -> hPutStr stdout ('\t':show (i::Int))) intervalNs hPutStrLn stdout (if printLine == 1 then '\t':v else "") else putStrLn (replicate (length multiples4) '\t' ++ if printLine == 1 then '\t':v else "")) ; return myThread }) (killThread) (\_ -> putStr "")