{-# 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 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.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

{-| @ 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 :: FilePath
-> Bool
-> (Int, Int)
-> Bool
-> [FilePath]
-> [FilePath]
-> Coeffs2
-> Coeffs2
-> FilePath
-> FilePath
-> Int
-> Int
-> FilePath
-> IO ()
generalProc FilePath
fileDu Bool
pairwisePermutations (Int
gr1,Int
gr2) Bool
lstW [FilePath]
multiples2 [FilePath]
lInes Coeffs2
coeffs Coeffs2
coeffsWX FilePath
file FilePath
gzS Int
printLine Int
toOneLine FilePath
choice
 | [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
lInes = do
    [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs <- FilePath -> IO [[[[Sound8]]] -> [[Double]]]
readSyllableDurations FilePath
fileDu
    FilePath
contents <- FilePath -> IO FilePath
readFile FilePath
file
    let !flines :: [FilePath]
flines
          | Int
gr1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> Int -> FilePath -> [FilePath]
fLinesN (if Bool
pairwisePermutations then Int
10 else Int
7) Int
toOneLine FilePath
contents
          | Bool
otherwise = Int -> Int -> FilePath -> [FilePath]
prepareGrowTextMN Int
gr1 Int
gr2 (FilePath -> [FilePath])
-> (FilePath -> FilePath) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unlines ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> FilePath -> [FilePath]
fLinesN (if Bool
pairwisePermutations then Int
10 else Int
7) Int
toOneLine (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
contents
    [[[[Sound8]]] -> [[Double]]]
-> Bool
-> Bool
-> Coeffs2
-> Coeffs2
-> Int
-> Int
-> FilePath
-> [FilePath]
-> [FilePath]
-> IO ()
getData3 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Bool
pairwisePermutations Bool
lstW Coeffs2
coeffs Coeffs2
coeffsWX (Bool -> FilePath -> [FilePath] -> Int
getIntervalsNS Bool
lstW FilePath
gzS [FilePath]
flines) Int
printLine FilePath
choice [FilePath]
multiples2 [FilePath]
flines
 | Bool
otherwise = do
    [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs <- FilePath -> IO [[[[Sound8]]] -> [[Double]]]
readSyllableDurations FilePath
fileDu
    FilePath
contents <- FilePath -> IO FilePath
readFile FilePath
file
    let !flines :: [FilePath]
flines = (if Int
gr1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [FilePath] -> [FilePath]
forall a. a -> a
id else Int -> Int -> FilePath -> [FilePath]
prepareGrowTextMN Int
gr1 Int
gr2 (FilePath -> [FilePath])
-> ([FilePath] -> FilePath) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unlines) ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> FilePath -> [FilePath]
fLinesN (if Bool
pairwisePermutations then Int
10 else Int
7) Int
toOneLine (FilePath -> [FilePath])
-> (FilePath -> FilePath) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unlines ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath] -> [FilePath]
linesFromArgsG [FilePath]
lInes ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> FilePath -> [FilePath]
fLinesN (if Bool
pairwisePermutations then Int
10 else Int
7) Int
0 (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
contents
    [[[[Sound8]]] -> [[Double]]]
-> Bool
-> Bool
-> Coeffs2
-> Coeffs2
-> Int
-> Int
-> FilePath
-> [FilePath]
-> [FilePath]
-> IO ()
getData3 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Bool
pairwisePermutations Bool
lstW Coeffs2
coeffs Coeffs2
coeffsWX (Bool -> FilePath -> [FilePath] -> Int
getIntervalsNS Bool
lstW FilePath
gzS [FilePath]
flines) Int
printLine FilePath
choice [FilePath]
multiples2 [FilePath]
flines

linesFromArgs1 :: Int -> String -> [String] -> [String]
linesFromArgs1 :: Int -> FilePath -> [FilePath] -> [FilePath]
linesFromArgs1 Int
n FilePath
xs [FilePath]
yss =
  let (!FilePath
ys,!FilePath
zs) = (\(FilePath
x,FilePath
z) -> (FilePath
x, Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
z)) ((FilePath, FilePath) -> (FilePath, FilePath))
-> (FilePath -> (FilePath, FilePath))
-> FilePath
-> (FilePath, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') (FilePath -> (FilePath, FilePath))
-> FilePath -> (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
xs
      !ts :: [Int]
ts = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
abs) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (FilePath -> Maybe Int
forall a. Read a => FilePath -> Maybe a
readMaybe FilePath
ys::Maybe Int), Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
n (FilePath -> Maybe Int
forall a. Read a => FilePath -> Maybe a
readMaybe FilePath
zs::Maybe Int)] in
        Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
drop ([Int] -> Int
forall a. [a] -> a
head [Int]
ts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
take ([Int] -> Int
forall a. [a] -> a
last [Int]
ts) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
yss

linesFromArgsG :: [String] -> [String] -> [String]
linesFromArgsG :: [FilePath] -> [FilePath] -> [FilePath]
linesFromArgsG [FilePath]
xss [FilePath]
yss = let n :: Int
n = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
yss in (FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\FilePath
ts -> Int -> FilePath -> [FilePath] -> [FilePath]
linesFromArgs1 Int
n FilePath
ts [FilePath]
yss) [FilePath]
xss

getData3
 :: [[[[Sound8]]] -> [[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 :: [[[[Sound8]]] -> [[Double]]]
-> Bool
-> Bool
-> Coeffs2
-> Coeffs2
-> Int
-> Int
-> FilePath
-> [FilePath]
-> [FilePath]
-> IO ()
getData3 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Bool
pairwisePermutations Bool
lstW Coeffs2
coeffs Coeffs2
coeffsWX Int
gz Int
printLine FilePath
choice [FilePath]
multiples3 [FilePath]
zss = let !permsV4 :: Array Int [Array Int Int]
permsV4 = if Bool
pairwisePermutations then Int -> Array Int [Array Int Int]
genPairwisePermutationsArrLN Int
10 else Array Int [Array Int Int]
genPermutationsArrL in FilePath -> IO ()
putStrLn (Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
multiples3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
'\t' FilePath -> FilePath -> FilePath
forall a. Monoid a => a -> a -> a
`mappend` Int -> FilePath
forall a. Show a => a -> FilePath
show Int
gz) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([[[[Sound8]]] -> [[Double]]]
-> Bool
-> Coeffs2
-> Coeffs2
-> Int
-> Int
-> FilePath
-> [FilePath]
-> Array Int [Array Int Int]
-> FilePath
-> IO ()
process1Line [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Bool
lstW Coeffs2
coeffs Coeffs2
coeffsWX Int
gz Int
printLine FilePath
choice [FilePath]
multiples3 Array Int [Array Int Int]
permsV4) [FilePath]
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 :: [[[[Sound8]]] -> [[Double]]]
-> Bool
-> Coeffs2
-> Coeffs2
-> Int
-> Int
-> FilePath
-> [FilePath]
-> Array Int [Array Int Int]
-> FilePath
-> IO ()
process1Line [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Bool
lstW Coeffs2
coeffs Coeffs2
coeffsWX Int
gz Int
printLine FilePath
choice [FilePath]
multiples4 !Array Int [Array Int Int]
permsV50 FilePath
v
 | [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
multiples4 = IO ThreadId -> (ThreadId -> IO ()) -> (ThreadId -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (do {
    ThreadId
myThread <- IO () -> IO ThreadId
forkIO (do
     let !v2 :: [FilePath]
v2 = FilePath -> [FilePath]
words FilePath
v
         !l2 :: Int
l2 = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
v2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
     if Int
l2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (if Bool
lstW then Int
1 else Int
0) then do
      let !permsV5 :: [Array Int Int]
permsV5 = EncodedCnstrs -> [Array Int Int] -> [Array Int Int]
forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
EncodedCnstrs -> t (Array Int Int) -> t (Array Int Int)
decodeConstraint1 (EncodedCnstrs -> Maybe EncodedCnstrs -> EncodedCnstrs
forall a. a -> Maybe a -> a
fromMaybe (Int -> EncodedCnstrs
forall a b. a -> EncodedContraints a b
E Int
1) (Maybe EncodedCnstrs -> EncodedCnstrs)
-> (Bool -> Maybe EncodedCnstrs) -> Bool -> EncodedCnstrs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath -> Maybe EncodedCnstrs
readMaybeECG (Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (FilePath -> Maybe EncodedCnstrs)
-> (Bool -> FilePath) -> Bool -> Maybe EncodedCnstrs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> FilePath
showB (Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Bool -> EncodedCnstrs) -> Bool -> EncodedCnstrs
forall a b. (a -> b) -> a -> b
$ Bool
lstW) ([Array Int Int] -> [Array Int Int])
-> (Int -> [Array Int Int]) -> Int -> [Array Int Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            Array Int [Array Int Int] -> Int -> [Array Int Int]
forall i e. Array i e -> Int -> e
unsafeAt Array Int [Array Int Int]
permsV50 (Int -> [Array Int Int]) -> Int -> [Array Int Int]
forall a b. (a -> b) -> a -> b
$ Int
l2
          ((!Double
minE,!Double
maxE),!Double
data2) = Eval ((Double, Double), Double) -> ((Double, Double), Double)
forall a. Eval a -> a
runEval (Strategy (Double, Double)
-> Strategy Double -> Strategy ((Double, Double), Double)
forall a b. Strategy a -> Strategy b -> Strategy (a, b)
parTuple2 Strategy (Double, Double)
forall a. Strategy a
rpar Strategy Double
forall a. Strategy a
rpar ([Double] -> (Double, Double)
forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
t a -> (a, a)
minMax11C ([Double] -> (Double, Double))
-> ([FilePath] -> [Double]) -> [FilePath] -> (Double, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Double) -> [FilePath] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (FuncRep2 FilePath Double Double -> FilePath -> Double
forall (t :: * -> *) a b c. FuncRep2 (t a) b c -> t a -> c
toTransPropertiesF' (if Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
1 FilePath
choice FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"x"
            Bool -> Bool -> Bool
|| Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
1 FilePath
choice FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"w" Bool -> Bool -> Bool
|| (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
1 FilePath
choice FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"H" Bool -> Bool -> Bool
&& (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
2 FilePath
choice) FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"w",FilePath
"x"]))
              then [[[[Sound8]]] -> [[Double]]]
-> (Double -> Double)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double Double
forall c.
Ord c =>
[[[[Sound8]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double c
chooseMax [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Double -> Double
forall a. a -> a
id Coeffs2
coeffsWX FilePath
choice
              else [[[[Sound8]]] -> [[Double]]]
-> (Double -> Double)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double Double
forall c.
Ord c =>
[[[[Sound8]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double c
chooseMax [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Double -> Double
forall a. a -> a
id Coeffs2
coeffs FilePath
choice)) ([FilePath] -> [Double])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                Char
-> (FilePath -> FilePath)
-> ([FilePath] -> [FilePath])
-> (FilePath -> FilePath)
-> [Array Int Int]
-> [FilePath]
-> [FilePath]
forall a (t :: * -> *).
(Eq a, Foldable t, InsertLeft t a, Monoid (t a),
 Monoid (t (t a))) =>
a
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> ([a] -> t a)
-> [Array Int Int]
-> t (t a)
-> [t a]
uniquenessVariants2GNBL Char
' ' FilePath -> FilePath
forall a. a -> a
id [FilePath] -> [FilePath]
forall a. a -> a
id FilePath -> FilePath
forall a. a -> a
id [Array Int Int]
permsV5 ([FilePath] -> (Double, Double)) -> [FilePath] -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ [FilePath]
v2, FuncRep2 FilePath Double Double -> FilePath -> Double
forall (t :: * -> *) a b c. FuncRep2 (t a) b c -> t a -> c
toTransPropertiesF' (if Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
1 FilePath
choice FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"x"
                  Bool -> Bool -> Bool
|| Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
1 FilePath
choice FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"w" then [[[[Sound8]]] -> [[Double]]]
-> (Double -> Double)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double Double
forall c.
Ord c =>
[[[[Sound8]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double c
chooseMax [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Double -> Double
forall a. a -> a
id Coeffs2
coeffsWX FilePath
choice
                    else [[[[Sound8]]] -> [[Double]]]
-> (Double -> Double)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double Double
forall c.
Ord c =>
[[[[Sound8]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double c
chooseMax [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Double -> Double
forall a. a -> a
id Coeffs2
coeffs FilePath
choice) (FilePath -> Double)
-> (FilePath -> FilePath) -> FilePath -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unwords ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> [FilePath]
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a), Monoid (t (t a))) =>
t a -> t a -> t (t a)
subG FilePath
" 01-" (FilePath -> Double) -> FilePath -> Double
forall a b. (a -> b) -> a -> b
$ FilePath
v))
          (!Int
wordsN,!Int
intervalN) = (Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2, Double -> Double -> Int -> Double -> Int
forall b c. (RealFrac b, Integral c) => b -> b -> c -> b -> c
intervalNRealFrac Double
minE Double
maxE Int
gz Double
data2)
          !ratio :: Double
ratio = if Double
maxE Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0.0 then Double
0.0 else Double
2.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
data2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
minE Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
maxE)
      Handle -> FilePath -> IO ()
hPutStr Handle
stdout (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Double -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat (FilePath -> Maybe Int
precChoice FilePath
choice) Double
minE (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"\t"
      Handle -> FilePath -> IO ()
hPutStr Handle
stdout (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Double -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat (FilePath -> Maybe Int
precChoice FilePath
choice) Double
data2 (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"\t"
      Handle -> FilePath -> IO ()
hPutStr Handle
stdout (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Double -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat (FilePath -> Maybe Int
precChoice FilePath
choice) Double
maxE (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"\t"
      Handle -> FilePath -> IO ()
hPutStr Handle
stdout (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Double -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) (Double
data2 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
minE) (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"\t"
      Handle -> FilePath -> IO ()
hPutStr Handle
stdout (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Double -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) (Double
maxE Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
minE) (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"\t"
      Handle -> FilePath -> IO ()
hPutStr Handle
stdout (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Double -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) (Double
maxE Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
data2) (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"\t"
      Handle -> FilePath -> IO ()
hPutStr Handle
stdout (FilePath -> IO ()) -> (FilePath -> FilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Double -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8) Double
ratio (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"\t"
      Handle -> FilePath -> IO ()
hPutStr Handle
stdout (Char
'\t'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
wordsN::Int))
      Handle -> FilePath -> IO ()
hPutStr Handle
stdout (Char
'\t'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
intervalN::Int))
      Handle -> FilePath -> IO ()
hPutStrLn Handle
stdout (if Int
printLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Char
'\t'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
v else FilePath
"")
     else FilePath -> IO ()
putStrLn (Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
multiples4) Char
'\t' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ if Int
printLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Char
'\t'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
v else FilePath
""))
   ; ThreadId -> IO ThreadId
forall (m :: * -> *) a. Monad m => a -> m a
return ThreadId
myThread }) (ThreadId -> IO ()
killThread) (\ThreadId
_ -> FilePath -> IO ()
putStr FilePath
"")
 | Bool
otherwise = IO ThreadId -> (ThreadId -> IO ()) -> (ThreadId -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (do {
   ThreadId
myThread <- IO () -> IO ThreadId
forkIO (do
    let !v2 :: [FilePath]
v2 = FilePath -> [FilePath]
words FilePath
v
        !l2 :: Int
l2 = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
v2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
    if Int
l2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (if Bool
lstW then Int
1 else Int
0) then do
     let !permsV5 :: [Array Int Int]
permsV5 = EncodedCnstrs -> [Array Int Int] -> [Array Int Int]
forall (t :: * -> *).
(InsertLeft t (Array Int Int), Monoid (t (Array Int Int))) =>
EncodedCnstrs -> t (Array Int Int) -> t (Array Int Int)
decodeConstraint1 (EncodedCnstrs -> Maybe EncodedCnstrs -> EncodedCnstrs
forall a. a -> Maybe a -> a
fromMaybe (Int -> EncodedCnstrs
forall a b. a -> EncodedContraints a b
E Int
1) (Maybe EncodedCnstrs -> EncodedCnstrs)
-> (Bool -> Maybe EncodedCnstrs) -> Bool -> EncodedCnstrs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath -> Maybe EncodedCnstrs
readMaybeECG (Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (FilePath -> Maybe EncodedCnstrs)
-> (Bool -> FilePath) -> Bool -> Maybe EncodedCnstrs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> FilePath
showB (Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Bool -> EncodedCnstrs) -> Bool -> EncodedCnstrs
forall a b. (a -> b) -> a -> b
$ Bool
lstW) ([Array Int Int] -> [Array Int Int])
-> (Int -> [Array Int Int]) -> Int -> [Array Int Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            Array Int [Array Int Int] -> Int -> [Array Int Int]
forall i e. Array i e -> Int -> e
unsafeAt Array Int [Array Int Int]
permsV50 (Int -> [Array Int Int]) -> Int -> [Array Int Int]
forall a b. (a -> b) -> a -> b
$ Int
l2
         rs :: [((Double, Double), Double, Int)]
rs = Strategy ((Double, Double), Double, Int)
-> (FilePath -> ((Double, Double), Double, Int))
-> [FilePath]
-> [((Double, Double), Double, Int)]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
parMap Strategy ((Double, Double), Double, Int)
forall a. Strategy a
rpar (\FilePath
choiceMMs -> ([Double] -> (Double, Double)
forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
t a -> (a, a)
minMax11C ([Double] -> (Double, Double))
-> ([FilePath] -> [Double]) -> [FilePath] -> (Double, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           (FilePath -> Double) -> [FilePath] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (FuncRep2 FilePath Double Double -> FilePath -> Double
forall (t :: * -> *) a b c. FuncRep2 (t a) b c -> t a -> c
toTransPropertiesF' (if Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
1 FilePath
choiceMMs FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"x" Bool -> Bool -> Bool
|| Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
1 FilePath
choiceMMs FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"w" Bool -> Bool -> Bool
||
            (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
1 FilePath
choice FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"H" Bool -> Bool -> Bool
&& (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
2 FilePath
choice) FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"w",FilePath
"x"]))
             then [[[[Sound8]]] -> [[Double]]]
-> (Double -> Double)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double Double
forall c.
Ord c =>
[[[[Sound8]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double c
chooseMax [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Double -> Double
forall a. a -> a
id Coeffs2
coeffsWX FilePath
choiceMMs
             else [[[[Sound8]]] -> [[Double]]]
-> (Double -> Double)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double Double
forall c.
Ord c =>
[[[[Sound8]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double c
chooseMax [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Double -> Double
forall a. a -> a
id Coeffs2
coeffs FilePath
choiceMMs)) ([FilePath] -> [Double])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              Char
-> (FilePath -> FilePath)
-> ([FilePath] -> [FilePath])
-> (FilePath -> FilePath)
-> [Array Int Int]
-> [FilePath]
-> [FilePath]
forall a (t :: * -> *).
(Eq a, Foldable t, InsertLeft t a, Monoid (t a),
 Monoid (t (t a))) =>
a
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> ([a] -> t a)
-> [Array Int Int]
-> t (t a)
-> [t a]
uniquenessVariants2GNBL Char
' ' FilePath -> FilePath
forall a. a -> a
id [FilePath] -> [FilePath]
forall a. a -> a
id FilePath -> FilePath
forall a. a -> a
id [Array Int Int]
permsV5 ([FilePath] -> (Double, Double)) -> [FilePath] -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ [FilePath]
v2,
               FuncRep2 FilePath Double Double -> FilePath -> Double
forall (t :: * -> *) a b c. FuncRep2 (t a) b c -> t a -> c
toTransPropertiesF' (if Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
1 FilePath
choiceMMs FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"x" Bool -> Bool -> Bool
|| Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
1 FilePath
choiceMMs FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"w" Bool -> Bool -> Bool
||
                (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
1 FilePath
choice FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"H" Bool -> Bool -> Bool
&& (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
2 FilePath
choice) FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"w",FilePath
"x"]))
                 then [[[[Sound8]]] -> [[Double]]]
-> (Double -> Double)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double Double
forall c.
Ord c =>
[[[[Sound8]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double c
chooseMax [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Double -> Double
forall a. a -> a
id Coeffs2
coeffsWX FilePath
choiceMMs
                 else [[[[Sound8]]] -> [[Double]]]
-> (Double -> Double)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double Double
forall c.
Ord c =>
[[[[Sound8]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double c
chooseMax [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Double -> Double
forall a. a -> a
id Coeffs2
coeffs FilePath
choiceMMs) (FilePath -> Double)
-> (FilePath -> FilePath) -> FilePath -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  [FilePath] -> FilePath
unwords ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> [FilePath]
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a), Monoid (t (t a))) =>
t a -> t a -> t (t a)
subG FilePath
" 01-" (FilePath -> Double) -> FilePath -> Double
forall a b. (a -> b) -> a -> b
$ FilePath
v,Int
gz)) [FilePath]
multiples4
         (!Int
wordsN,![Int]
intervalNs) = (Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2, (((Double, Double), Double, Int) -> Int)
-> [((Double, Double), Double, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\((!Double
x,!Double
y),!Double
z,!Int
t) -> Double -> Double -> Int -> Double -> Int
forall b c. (RealFrac b, Integral c) => b -> b -> c -> b -> c
intervalNRealFrac Double
x Double
y Int
t Double
z) [((Double, Double), Double, Int)]
rs)
           in do
            Handle -> FilePath -> IO ()
hPutStr Handle
stdout (Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
wordsN::Int))
            (Int -> IO ()) -> [Int] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Int
i -> Handle -> FilePath -> IO ()
hPutStr Handle
stdout (Char
'\t'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
i::Int))) [Int]
intervalNs
            Handle -> FilePath -> IO ()
hPutStrLn Handle
stdout (if Int
printLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Char
'\t'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
v else FilePath
"")
    else FilePath -> IO ()
putStrLn (Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
multiples4) Char
'\t' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ if Int
printLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Char
'\t'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
v else FilePath
""))
  ; ThreadId -> IO ThreadId
forall (m :: * -> *) a. Monad m => a -> m a
return ThreadId
myThread }) (ThreadId -> IO ()
killThread) (\ThreadId
_ -> FilePath -> IO ()
putStr FilePath
"")