{-# OPTIONS_GHC -threaded -rtsopts #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns, FlexibleContexts #-}

-- |
-- Module      :  Phonetic.Languages.General.GetTextualInfo
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Library module that contains functions earlier used by the propertiesTextG3
-- executable for the Ukrainian language (see: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array).
-- Is rewritten from the Phonetic.Languages.GetTextualInfo module from the
-- @phonetic-languages-simplified-examples-array@ package.

module Phonetic.Languages.General.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 Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.PrepareText
import Numeric (showFFloat)
import Phonetic.Languages.Filters
import Data.Char (isAlpha)
import Data.Statistics.RulesIntervalsPlus
import Data.MinMax.Preconditions
import Phonetic.Languages.Array.General.PropertiesSyllablesG2
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 Phonetic.Languages.Basis
import Phonetic.Languages.Simplified.DataG.Partir
import Phonetic.Languages.Simplified.Array.General.FuncRep2RelatedG2
import Languages.UniquenessPeriods.Array.Constraints.Encoded
import Phonetic.Languages.General.SimpleConstraints
import Phonetic.Languages.General.Common
import Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.Syllables
import qualified Phonetic.Languages.Permutations.Represent as R
import Phonetic.Languages.EmphasisG

generalProc
 :: R.PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
 -> (Int,Int) -- ^ Argument to specify possible 'line growing'.
 -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
 -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
 -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
 -> SegmentRulesG
 -> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.
 -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
 -- depends on two parameters. Is specific for every phonetic language and every representation, so must be provided
 -- by the user in every case. The example of the function can be found in the package @phonetic-languages-simplified-properties-array@.
 -> [MappingFunctionPL] -- ^ A list of 'PhoPaaW'-based different functions that specifies the syllables durations in the PhoPaaW mode, analogues of the
 -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one must be probably the most
 -- exact one and, therefore, the default one.
 -> Concatenations -- ^ Data used to concatenate (prepend) the basic grammar preserving words and word sequences to the next word to
 -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.
 -> Concatenations -- ^ Data used to concatenate (append) the basic grammar preserving words and word sequences to the next word to
 -- leave the most of the meaning (semantics) of the text available to easy understanding while reading and listening to.
 -> String
 -> String
 -> String
 -> Bool
 -> [String]
 -> [String]
 -> Coeffs2 -- ^ This value is used when property choice is NOT from the \"w\" or \"x\" lines.
 -> Coeffs2 -- ^ This value is used when property choice is from the \"w\" or \"x\" lines.
 -> FilePath
 -> String
 -> Int
 -> Int
 -> String -- ^ Is intended to be one of the following strings: \"02y\", \"02z\", \"03y\", \"03z\", \"04y\", \"04z\",
 -- \"0y\", \"0z\", \"y\", \"y0\", \"y2\", \"y3\", \"y4\", \"yy\", \"yy2\", \"yy3\", \"z\", \"z2\", \"z3\", \"z4\",
 -- \"zz\", \"zz2\", \"zz3\", \"zz4\" or some other one. Since 0.5.0.0 version can also
 -- process \"w\" and \"x\"-based lines properties. Specifies the applied properties
 -- to get the result. The \"z\"-line uses \'F\' functions.
 -- @ 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.
 -> IO ()
generalProc :: PermutationsType
-> (Int, Int)
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Concatenations
-> Concatenations
-> String
-> String
-> String
-> Bool
-> [String]
-> [String]
-> Coeffs2
-> Coeffs2
-> String
-> String
-> Int
-> Int
-> String
-> IO ()
generalProc PermutationsType
pairwisePermutations (Int
gr1,Int
gr2) GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
rs Concatenations
ysss Concatenations
zzzsss String
xs String
js String
vs Bool
lstW [String]
multiples2 [String]
lInes Coeffs2
coeffs Coeffs2
coeffsWX String
file String
gzS Int
printLine Int
toOneLine String
choice
 | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
lInes = do
    String
contents <- String -> IO String
readFile String
file
    let !flines :: [String]
flines
           | Int
gr1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int
-> Concatenations
-> Concatenations
-> String
-> String
-> String
-> Int
-> String
-> [String]
fLinesN (if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
R.P Int
0 then Int
10 else Int
7) Concatenations
ysss Concatenations
zzzsss String
xs String
js String
vs Int
toOneLine String
contents
           | Bool
otherwise = Int
-> Int
-> Concatenations
-> Concatenations
-> String
-> String
-> [String]
prepareGrowTextMN Int
gr1 Int
gr2 Concatenations
ysss Concatenations
zzzsss String
xs (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Concatenations
-> Concatenations
-> String
-> String
-> String
-> Int
-> String
-> [String]
fLinesN (if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
R.P Int
0 then Int
10 else Int
7) Concatenations
ysss Concatenations
zzzsss String
xs String
js String
vs Int
toOneLine (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
contents
    PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Bool
-> Coeffs2
-> Coeffs2
-> Int
-> Int
-> String
-> [String]
-> [String]
-> IO ()
getData3 PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
rs Bool
lstW Coeffs2
coeffs Coeffs2
coeffsWX (Bool -> String -> [String] -> Int
getIntervalsNS Bool
lstW String
gzS [String]
flines) Int
printLine String
choice [String]
multiples2 [String]
flines
 | Bool
otherwise = do
    String
contents <- String -> IO String
readFile String
file
    let !flines :: [String]
flines
           | Int
gr1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int
-> Concatenations
-> Concatenations
-> String
-> String
-> String
-> Int
-> String
-> [String]
fLinesN (if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
R.P Int
0 then Int
10 else Int
7) Concatenations
ysss Concatenations
zzzsss String
xs String
js String
vs Int
toOneLine (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String] -> [String]
linesFromArgsG [String]
lInes ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Concatenations
-> Concatenations
-> String
-> String
-> String
-> Int
-> String
-> [String]
fLines Concatenations
ysss Concatenations
zzzsss String
xs String
js String
vs Int
0 (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
contents
           | Bool
otherwise = Int
-> Int
-> Concatenations
-> Concatenations
-> String
-> String
-> [String]
prepareGrowTextMN Int
gr1 Int
gr2 Concatenations
ysss Concatenations
zzzsss String
xs (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Concatenations
-> Concatenations
-> String
-> String
-> String
-> Int
-> String
-> [String]
fLinesN (if PermutationsType
pairwisePermutations PermutationsType -> PermutationsType -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
R.P Int
0 then Int
10 else Int
7) Concatenations
ysss Concatenations
zzzsss String
xs String
js String
vs Int
toOneLine (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String] -> [String]
linesFromArgsG [String]
lInes ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Concatenations
-> Concatenations
-> String
-> String
-> String
-> Int
-> String
-> [String]
fLines Concatenations
ysss Concatenations
zzzsss String
xs String
js String
vs Int
0 (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
contents
    PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Bool
-> Coeffs2
-> Coeffs2
-> Int
-> Int
-> String
-> [String]
-> [String]
-> IO ()
getData3 PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
rs Bool
lstW Coeffs2
coeffs Coeffs2
coeffsWX (Bool -> String -> [String] -> Int
getIntervalsNS Bool
lstW String
gzS [String]
flines) Int
printLine String
choice [String]
multiples2 [String]
flines

linesFromArgs1
 :: Int
 -> String
 -> [String]
 -> [String]
linesFromArgs1 :: Int -> String -> [String] -> [String]
linesFromArgs1 Int
n String
xs [String]
yss =
  let (!String
ys,!String
zs) = (\(String
x,String
z) -> (String
x, Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 String
z)) ((String, String) -> (String, String))
-> (String -> (String, String)) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ String
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 (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
ys::Maybe Int), Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
n (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
zs::Maybe Int)] in
        Int -> [String] -> [String]
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) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take ([Int] -> Int
forall a. [a] -> a
last [Int]
ts) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
yss

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

getData3
 :: R.PermutationsType -- ^ Whether to use just one of the express permutations, or the full universal set.
 -> GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
 -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
 -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
 -> SegmentRulesG
 -> String
 -> String
 -> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.
 -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
 -- depends on two parameters. Is specific for every phonetic language and every representation, so must be provided
 -- by the user in every case. The example of the function can be found in the package @phonetic-languages-simplified-properties-array@.
 -> [MappingFunctionPL] -- ^ A list of 'PhoPaaW'-based different functions that specifies the syllables durations in the PhoPaaW mode, analogues of the
 -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one must be probably the most
 -- exact one and, therefore, the default one.
 -> Bool
 -> Coeffs2 -- ^ This value is used when property choice is NOT from the \"w\" or \"x\" lines.
 -> Coeffs2 -- ^ This value is used when property choice is from the \"w\" or \"x\" lines.
 -> Int
 -> Int
 -> String -- ^ Is intended to be one of the following strings: \"02y\", \"02z\", \"03y\", \"03z\", \"04y\", \"04z\",
 -- \"0y\", \"0z\", \"y\", \"y0\", \"y2\", \"y3\", \"y4\", \"yy\", \"yy2\", \"yy3\", \"z\", \"z2\", \"z3\", \"z4\",
 -- \"zz\", \"zz2\", \"zz3\", \"zz4\" or some other one. Since 0.5.0.0 version can also
 -- process \"w\" and \"x\"-based lines properties. Specifies the applied properties
 -- to get the result. The \"z\"-line uses \'F\' functions.
 -- @ 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.
 -> [String]
 -> [String]
 -> IO ()
getData3 :: PermutationsType
-> GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Bool
-> Coeffs2
-> Coeffs2
-> Int
-> Int
-> String
-> [String]
-> [String]
-> IO ()
getData3 PermutationsType
pairwisePermutations GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
rs Bool
lstW Coeffs2
coeffs Coeffs2
coeffsWX Int
gz Int
printLine String
choice0 [String]
multiples3 [String]
zss =
  let  !choice :: String
choice = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'a') String
choice0
       !permsV4 :: Array Int [Array Int Int]
permsV4 = case PermutationsType
pairwisePermutations of
        R.P Int
2 -> Int -> Array Int [Array Int Int]
genPairwisePermutationsArrLN Int
10
        R.P Int
1 -> Int -> Array Int [Array Int Int]
genElementaryPermutationsArrLN1 Int
10
        PermutationsType
_ -> Array Int [Array Int Int]
genPermutationsArrL in do
          String -> IO ()
putStrLn (Int -> Char -> String
forall a. Int -> a -> [a]
replicate ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
multiples3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
'\t' String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` Int -> String
forall a. Show a => a -> String
show Int
gz)
          (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Bool
-> Coeffs2
-> Coeffs2
-> Int
-> Int
-> String
-> [String]
-> Array Int [Array Int Int]
-> String
-> IO ()
process1Line GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
rs Bool
lstW Coeffs2
coeffs Coeffs2
coeffsWX Int
gz Int
printLine String
choice [String]
multiples3 Array Int [Array Int Int]
permsV4) [String]
zss

process1Line
 :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
 -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
  -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
 -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
 -> SegmentRulesG
 -> String
 -> String
 -> (Double -> String -> MappingFunctionPL) -- ^ The function that is needed in the 'procRhythmicity23F' function.
 -- Specifies a way how the syllables represented in the phonetic language approach transforms into their durations and
 -- depends on two parameters. Is specific for every phonetic language and every representation, so must be provided
 -- by the user in every case. The example of the function can be found in the package @phonetic-languages-simplified-properties-array@.
 -> [MappingFunctionPL]  -- ^ A list of either 'PhoPaaW'-based or 'SaaW'-based (and not both ones) different functions that specifies the syllables durations in the PhoPaaW or SaaW mode respectively (the former one has been introduced earlier), analogues of the
 -- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The first one in case of 'PhoPaaW'-based ones must be probably the most
 -- exact one and, therefore, the default one.
 -> Bool
 -> Coeffs2 -- ^ This value is used when property choice is NOT from the \"w\" or \"x\" lines.
 -> Coeffs2 -- ^ This value is used when property choice is from the \"w\" or \"x\" lines.
 -> Int
 -> Int
 -> String -- ^ Is intended to be one of the following strings: \"02y\", \"02z\", \"03y\", \"03z\", \"04y\", \"04z\",
 -- \"0y\", \"0z\", \"y\", \"y0\", \"y2\", \"y3\", \"y4\", \"yy\", \"yy2\", \"yy3\", \"z\", \"z2\", \"z3\", \"z4\",
 -- \"zz\", \"zz2\", \"zz3\", \"zz4\" or some other one. Since 0.5.0.0 version can also
 -- process \"w\" and \"x\"-based lines properties. Specifies the applied properties
 -- to get the result. The \"z\"-line uses \'F\' functions.
 -- @ 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.
 -> [String]
 -> Array Int [Array Int Int]  -- ^ A permutations array of indices.
 -> String
 -> IO ()
process1Line :: GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> String -> MappingFunctionPL)
-> [MappingFunctionPL]
-> Bool
-> Coeffs2
-> Coeffs2
-> Int
-> Int
-> String
-> [String]
-> Array Int [Array Int Int]
-> String
-> IO ()
process1Line GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> String -> MappingFunctionPL
h [MappingFunctionPL]
qs Bool
lstW Coeffs2
coeffs Coeffs2
coeffsWX Int
gz Int
printLine String
choice [String]
multiples4 !Array Int [Array Int Int]
permsV50 String
v
 | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
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 :: [String]
v2 = String -> [String]
words String
v
         !l2 :: Int
l2 = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
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 -> String -> Maybe EncodedCnstrs
readMaybeECG (Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (String -> Maybe EncodedCnstrs)
-> (Bool -> String) -> Bool -> Maybe EncodedCnstrs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> String
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))
-> ([String] -> [Double]) -> [String] -> (Double, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadyForConstructionPL -> Double)
-> [ReadyForConstructionPL] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (FuncRep2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL -> Double
forall a b c. FuncRep2 a b c -> a -> c
toTransPropertiesF'2 (if Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"w" Bool -> Bool -> Bool
|| Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"x" then GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> Double)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double Double
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> Double
forall a. a -> a
id Double -> String -> MappingFunctionPL
h Coeffs2
coeffsWX [MappingFunctionPL]
qs String
choice String
"" else GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> Double)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double Double
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> Double
forall a. a -> a
id Double -> String -> MappingFunctionPL
h Coeffs2
coeffs [MappingFunctionPL]
qs String
choice String
"")) ([ReadyForConstructionPL] -> [Double])
-> ([String] -> [ReadyForConstructionPL]) -> [String] -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                (String -> ReadyForConstructionPL)
-> [String] -> [ReadyForConstructionPL]
forall a b. (a -> b) -> [a] -> [b]
map String -> ReadyForConstructionPL
StrG ([String] -> [ReadyForConstructionPL])
-> ([String] -> [String]) -> [String] -> [ReadyForConstructionPL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char
-> (String -> String)
-> ([String] -> [String])
-> (String -> String)
-> [Array Int Int]
-> [String]
-> [String]
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
' ' String -> String
forall a. a -> a
id [String] -> [String]
forall a. a -> a
id String -> String
forall a. a -> a
id [Array Int Int]
permsV5 ([String] -> (Double, Double)) -> [String] -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ [String]
v2, FuncRep2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL -> Double
forall a b c. FuncRep2 a b c -> a -> c
toTransPropertiesF'2 (if Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"w" Bool -> Bool -> Bool
|| Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choice String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"x" then GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> Double)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double Double
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> Double
forall a. a -> a
id Double -> String -> MappingFunctionPL
h Coeffs2
coeffsWX [MappingFunctionPL]
qs String
choice String
"" else GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> Double)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double Double
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> Double
forall a. a -> a
id Double -> String -> MappingFunctionPL
h Coeffs2
coeffs [MappingFunctionPL]
qs String
choice String
"") (ReadyForConstructionPL -> Double)
-> (String -> ReadyForConstructionPL) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                 String -> ReadyForConstructionPL
StrG (String -> ReadyForConstructionPL)
-> (String -> String) -> String -> ReadyForConstructionPL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a), Monoid (t (t a))) =>
t a -> t a -> t (t a)
subG (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
js String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
vs) (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ String
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 -> String -> IO ()
hPutStr Handle
stdout (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (String -> Maybe Int
precChoice String
choice) Double
minE (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\t"
      Handle -> String -> IO ()
hPutStr Handle
stdout (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (String -> Maybe Int
precChoice String
choice) Double
data2 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\t"
      Handle -> String -> IO ()
hPutStr Handle
stdout (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (String -> Maybe Int
precChoice String
choice) Double
maxE (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\t"
      Handle -> String -> IO ()
hPutStr Handle
stdout (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
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) (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\t"
      Handle -> String -> IO ()
hPutStr Handle
stdout (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
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) (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\t"
      Handle -> String -> IO ()
hPutStr Handle
stdout (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
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) (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\t"
      Handle -> String -> IO ()
hPutStr Handle
stdout (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Double -> String -> String
forall a. RealFloat a => Maybe Int -> a -> String -> String
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8) Double
ratio (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\t"
      Handle -> String -> IO ()
hPutStr Handle
stdout (Char
'\t'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
forall a. Show a => a -> String
show (Int
wordsN::Int))
      Handle -> String -> IO ()
hPutStr Handle
stdout (Char
'\t'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
forall a. Show a => a -> String
show (Int
intervalN::Int))
      Handle -> String -> IO ()
hPutStrLn Handle
stdout (if Int
printLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Char
'\t'Char -> String -> String
forall a. a -> [a] -> [a]
:String
v else String
"")
     else String -> IO ()
putStrLn (Int -> Char -> String
forall a. Int -> a -> [a]
replicate ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
multiples4) Char
'\t' String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Int
printLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Char
'\t'Char -> String -> String
forall a. a -> [a] -> [a]
:String
v else String
""))
   ; ThreadId -> IO ThreadId
forall (m :: * -> *) a. Monad m => a -> m a
return ThreadId
myThread }) (ThreadId -> IO ()
killThread) (\ThreadId
_ -> String -> IO ()
putStr String
"")
 | 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 :: [String]
v2 = String -> [String]
words String
v
        !l2 :: Int
l2 = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
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 -> String -> Maybe EncodedCnstrs
readMaybeECG (Int
l2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (String -> Maybe EncodedCnstrs)
-> (Bool -> String) -> Bool -> Maybe EncodedCnstrs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> String
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)
-> (String -> ((Double, Double), Double, Int))
-> [String]
-> [((Double, Double), Double, Int)]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
parMap Strategy ((Double, Double), Double, Int)
forall a. Strategy a
rpar (\String
choiceMMs -> ([Double] -> (Double, Double)
forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
t a -> (a, a)
minMax11C ([Double] -> (Double, Double))
-> ([String] -> [Double]) -> [String] -> (Double, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           (ReadyForConstructionPL -> Double)
-> [ReadyForConstructionPL] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (FuncRep2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL -> Double
forall a b c. FuncRep2 a b c -> a -> c
toTransPropertiesF'2 (if Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choiceMMs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"w" Bool -> Bool -> Bool
|| Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choiceMMs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"x" then GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> Double)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double Double
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> Double
forall a. a -> a
id Double -> String -> MappingFunctionPL
h Coeffs2
coeffsWX [MappingFunctionPL]
qs String
choiceMMs String
"" else GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> Double)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double Double
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> Double
forall a. a -> a
id Double -> String -> MappingFunctionPL
h Coeffs2
coeffs [MappingFunctionPL]
qs String
choiceMMs String
"")) ([ReadyForConstructionPL] -> [Double])
-> ([String] -> [ReadyForConstructionPL]) -> [String] -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             (String -> ReadyForConstructionPL)
-> [String] -> [ReadyForConstructionPL]
forall a b. (a -> b) -> [a] -> [b]
map String -> ReadyForConstructionPL
StrG ([String] -> [ReadyForConstructionPL])
-> ([String] -> [String]) -> [String] -> [ReadyForConstructionPL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char
-> (String -> String)
-> ([String] -> [String])
-> (String -> String)
-> [Array Int Int]
-> [String]
-> [String]
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
' ' String -> String
forall a. a -> a
id [String] -> [String]
forall a. a -> a
id String -> String
forall a. a -> a
id [Array Int Int]
permsV5 ([String] -> (Double, Double)) -> [String] -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ [String]
v2,
               FuncRep2 ReadyForConstructionPL Double Double
-> ReadyForConstructionPL -> Double
forall a b c. FuncRep2 a b c -> a -> c
toTransPropertiesF'2 (if Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choiceMMs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"w" Bool -> Bool -> Bool
|| Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
1 String
choiceMMs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"x" then GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> Double)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double Double
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> Double
forall a. a -> a
id Double -> String -> MappingFunctionPL
h Coeffs2
coeffsWX [MappingFunctionPL]
qs String
choiceMMs String
"" else GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> Double)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double Double
forall c.
Ord c =>
GWritingSystemPRPLX
-> [(Char, Char)]
-> CharPhoneticClassification
-> SegmentRulesG
-> String
-> String
-> (Double -> c)
-> (Double -> String -> MappingFunctionPL)
-> Coeffs2
-> [MappingFunctionPL]
-> String
-> String
-> FuncRep2 ReadyForConstructionPL Double c
chooseMax GWritingSystemPRPLX
wrs [(Char, Char)]
ks CharPhoneticClassification
arr SegmentRulesG
gs String
js String
vs Double -> Double
forall a. a -> a
id Double -> String -> MappingFunctionPL
h Coeffs2
coeffs [MappingFunctionPL]
qs String
choiceMMs String
"") (ReadyForConstructionPL -> Double)
-> (String -> ReadyForConstructionPL) -> String -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                 String -> ReadyForConstructionPL
StrG (String -> ReadyForConstructionPL)
-> (String -> String) -> String -> ReadyForConstructionPL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall (t :: * -> *) a.
(InsertLeft t a, Monoid (t a), Monoid (t (t a))) =>
t a -> t a -> t (t a)
subG (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
js String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
vs) (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ String
v,Int
gz)) [String]
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 -> String -> IO ()
hPutStr Handle
stdout (Int -> String
forall a. Show a => a -> String
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 -> String -> IO ()
hPutStr Handle
stdout (Char
'\t'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> String
forall a. Show a => a -> String
show (Int
i::Int))) [Int]
intervalNs
            Handle -> String -> IO ()
hPutStrLn Handle
stdout (if Int
printLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Char
'\t'Char -> String -> String
forall a. a -> [a] -> [a]
:String
v else String
"")
    else String -> IO ()
putStrLn (Int -> Char -> String
forall a. Int -> a -> [a]
replicate ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
multiples4) Char
'\t' String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Int
printLine Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Char
'\t'Char -> String -> String
forall a. a -> [a] -> [a]
:String
v else String
""))
  ; ThreadId -> IO ThreadId
forall (m :: * -> *) a. Monad m => a -> m a
return ThreadId
myThread }) (ThreadId -> IO ()
killThread) (\ThreadId
_ -> String -> IO ()
putStr String
"")