{-# OPTIONS_GHC -threaded -rtsopts #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns, FlexibleContexts #-}
-- |
-- Module : Phonetic.Languages.GetTextualInfo
-- Copyright : (c) OleksandrZhabenko 2020-2022
-- 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 Phonetic.Languages.Ukrainian.PrepareText
import Numeric (showFFloat)
import Phonetic.Languages.Filters
import Data.Statistics.RulesIntervalsPlus
import Data.MinMax.Preconditions
import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2Common
import Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2
import Phonetic.Languages.Simplified.StrictVG.Base
import Phonetic.Languages.Permutations.Arr
import Phonetic.Languages.Permutations.ArrMini
import Phonetic.Languages.Permutations.ArrMini1
import Phonetic.Languages.Simplified.DataG.Base
import Languages.UniquenessPeriods.Array.Constraints.Encoded
import Phonetic.Languages.Simplified.SimpleConstraints
import Phonetic.Languages.Common
import Melodics.Ukrainian.ArrInt8 (Sound8)
import Phonetic.Languages.Simplified.Array.Ukrainian.ReadProperties
import Phonetic.Languages.Permutations.Represent
import Languages.Ukrainian.Data
{-| @ 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.
-> PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
-> (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 /= Phonetic.Languages.Permutations.Represent.P 0 then 10 else 7) toOneLine contents
| otherwise = prepareGrowTextMN gr1 gr2 . unlines . fLinesN (if pairwisePermutations /= Phonetic.Languages.Permutations.Represent.P 0 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 /= Phonetic.Languages.Permutations.Represent.P 0 then 10 else 7) toOneLine . unlines . linesFromArgsG lInes . fLinesN (if pairwisePermutations /= Phonetic.Languages.Permutations.Represent.P 0 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
:: [[[[Sound8]]] -> [[Double]]] -- ^ Whether to use the own provided durations.
-> PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
-> Bool
-> Coeffs2
-> Coeffs2
-> Int
-> Int
-> String
-> [String]
-> [String]
-> IO ()
getData3 syllableDurationsDs pairwisePermutations lstW coeffs coeffsWX gz printLine choice multiples3 zss = let !permsV4 = case pairwisePermutations of { Phonetic.Languages.Permutations.Represent.P 2 -> genPairwisePermutationsArrLN 10; Phonetic.Languages.Permutations.Represent.P 1 -> genElementaryPermutationsArrLN1 10; ~rrr -> genPermutationsArrL } in putStrLn (replicate (length multiples3 + 1) '\t' `mappend` show gz) >> mapM_ (process1Line syllableDurationsDs lstW coeffs coeffsWX gz printLine choice multiples3 permsV4) zss
process1Line
:: [[[[Sound8]]] -> [[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 tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 syllableDurationsDs id coeffsWX choice
else chooseMax tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 syllableDurationsDs id coeffs choice)) .
uniquenessVariants2GNBL ' ' id id id permsV5 $ v2, toTransPropertiesF' (if take 1 choice == "x"
|| take 1 choice == "w" then chooseMax tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 syllableDurationsDs id coeffsWX choice
else chooseMax tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 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 tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 syllableDurationsDs id coeffsWX choiceMMs
else chooseMax tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 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 tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 syllableDurationsDs id coeffsWX choiceMMs
else chooseMax tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 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 "")