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

-- |
-- Module      :  Phonetic.Languages.Lines
-- Copyright   :  (c) OleksandrZhabenko 2020-2022
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Library functions for the rewritePoemG3 executable.
-- Inspired by: https://functional-art.org/2020/papers/Poetry-OleksandrZhabenko.pdf from the https://functional-art.org/2020/performances ;
-- Allows to rewrite the given text (usually a poetical one).

module Phonetic.Languages.Lines where

import Phonetic.Languages.Simplified.DeEnCoding (newLineEnding)
import Data.MinMax.Preconditions
import GHC.Arr
import Data.List (sort,nub)
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.Filters (unsafeSwapVecIWithMaxI)
import Text.Read (readMaybe)
import Data.Maybe (fromMaybe)
import Phonetic.Languages.Simplified.DataG.Base
import Phonetic.Languages.Basis
import Phonetic.Languages.Simplified.DataG.Partir
import Phonetic.Languages.Common
import Interpreter.StringConversion
import Melodics.Ukrainian.ArrInt8 (Sound8)
import Phonetic.Languages.Ukrainian.PrepareText (prepareGrowTextMN)
import Phonetic.Languages.Simplified.Array.Ukrainian.ReadProperties
import Phonetic.Languages.Permutations.Represent
import Languages.Ukrainian.Data
--import Phonetic.Languages.Array.Ukrainian.Common
import Phonetic.Languages.Coeffs
import Phonetic.Languages.Emphasis

{-| @ 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'.
@ since 0.12.0.0 -- Changed the arguments. Now it can run multiple rewritings for the one given data file
on the given list of choices for the properties given as the second ['String'] argument. Every new file is being
saved with the choice prefix.
-}
generalProcessment
 :: 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)
 -> Coeffs2
 -> [String]
 -> [String]
 -> Int
 -> FilePath -- ^ The file with the text in Ukranian to be rewritten.
 -> IO ()
generalProcessment :: String
-> PermutationsType
-> (Int, Int)
-> Coeffs2
-> [String]
-> [String]
-> Int
-> String
-> IO ()
generalProcessment String
fileDu PermutationsType
pairwisePermutations (Int
gr1,Int
gr2) Coeffs2
coeffs [String]
numericArgs [String]
choices0 Int
numberI String
file = do
  [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs <- String -> IO [[[[Sound8]]] -> [[Double]]]
readSyllableDurations String
fileDu
  let choices :: [String]
choices = forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Char
'a')) [String]
choices0
  String
contents <- String -> IO String
readFile String
file
  let !permsV :: Array Int [Array Int Int]
permsV
        | PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
2 = Int -> Array Int [Array Int Int]
genPairwisePermutationsArrLN Int
10
        | PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
== Int -> PermutationsType
P Int
1 = Int -> Array Int [Array Int Int]
genElementaryPermutationsArrLN1 Int
10
        | Bool
otherwise = Array Int [Array Int Int]
genPermutationsArrL
      !flines :: [String]
flines
        | Int
gr1 forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> Int -> String -> [String]
fLinesN (if PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
P Int
0 then Int
10 else Int
7) Int
0 String
contents
        | Bool
otherwise = Int -> Int -> String -> [String]
prepareGrowTextMN Int
gr1 Int
gr2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> String -> [String]
fLinesN (if PermutationsType
pairwisePermutations forall a. Eq a => a -> a -> Bool
/= Int -> PermutationsType
P Int
0 then Int
10 else Int
7) Int
0 forall a b. (a -> b) -> a -> b
$ String
contents
      !lasts :: [String]
lasts = forall a b. (a -> b) -> [a] -> [b]
map (\String
ts -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words forall a b. (a -> b) -> a -> b
$ String
ts then [] else forall a. [a] -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words forall a b. (a -> b) -> a -> b
$ String
ts) [String]
flines
  if forall a. Ord a => a -> a -> Ordering
compare Int
numberI Int
2 forall a. Eq a => a -> a -> Bool
== Ordering
LT then
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
choice -> String -> [String] -> IO ()
toFileStr (String
choice forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ String
file forall a. [a] -> [a] -> [a]
++ String
".new.txt") ([[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> Array Int [Array Int Int]
-> String
-> [String]
-> [String]
-> [String]
circle2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs Array Int [Array Int Int]
permsV String
choice [] forall a b. (a -> b) -> a -> b
$ [String]
flines)) [String]
choices
  else do
    let !intervalNmbrs :: [Int]
intervalNmbrs = (\[Int]
vs -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
vs then [Int
numberI] else forall a. Eq a => [a] -> [a]
nub [Int]
vs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
<= Int
numberI) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           forall a b. (a -> b) -> [a] -> [b]
map (\String
t -> forall a. a -> Maybe a -> a
fromMaybe Int
numberI (forall a. Read a => String -> Maybe a
readMaybe String
t::Maybe Int)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
2 forall a b. (a -> b) -> a -> b
$ [String]
numericArgs
        !us :: [String]
us = String -> [String]
words forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ [String]
flines
        !l2 :: Int
l2 = (forall a. Num a => a -> a -> a
subtract Int
3) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ [String]
us
    if forall a. Ord a => a -> a -> Ordering
compare Int
l2 Int
0 forall a. Eq a => a -> a -> Bool
/= Ordering
LT then do
      let !perms2 :: [Array Int Int]
perms2 = forall i e. Array i e -> Int -> e
unsafeAt Array Int [Array Int Int]
permsV forall a b. (a -> b) -> a -> b
$ Int
l2
          minMaxTuples :: [(Double, Double)]
minMaxTuples = let !frep20Zip :: [(String, FuncRep2 ReadyForConstructionUkr Double Double)]
frep20Zip = forall a b. [a] -> [b] -> [(a, b)]
zip [String]
choices forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\String
choice -> forall c.
Ord c =>
Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> [[[[Sound8]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> [Sound8]
-> String
-> String
-> FuncRep2 ReadyForConstructionUkr Double c
chooseMax Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs forall a. a -> a
id Coeffs2
coeffs (String -> [Sound8]
parsey0Choice String
choice) String
choice String
"") forall a b. (a -> b) -> a -> b
$ [String]
choices in
            forall a b. (a -> b) -> [a] -> [b]
map (\(String
_,FuncRep2 ReadyForConstructionUkr Double Double
frep20) -> forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
t a -> (a, a)
minMax11C forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. FuncRep2 a b c -> a -> b
toPropertiesF'2 FuncRep2 ReadyForConstructionUkr Double Double
frep20 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ReadyForConstructionUkr
Str) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              forall a (t :: * -> *).
(Eq a, Foldable t, InsertLeft t a, Monoid (t a),
 Monoid (t (t a))) =>
t a
-> t a
-> a
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> ([a] -> t a)
-> [Array Int Int]
-> t (t a)
-> [t a]
uniquenessVariants2GNPBL [] (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ [String]
lasts) Char
' ' forall a. a -> a
id forall a. a -> a
id forall a. a -> a
id [Array Int Int]
perms2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ [String]
us) [(String, FuncRep2 ReadyForConstructionUkr Double Double)]
frep20Zip
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(String
choice, (Double
minE,Double
maxE)) -> String -> [String] -> IO ()
toFileStr (String
choice forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ String
file forall a. [a] -> [a] -> [a]
++ String
".new.txt")
              ([[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> Array Int [Array Int Int]
-> String
-> [String]
-> Int
-> [Int]
-> Double
-> Double
-> [String]
-> [String]
circle2I [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs Array Int [Array Int Int]
permsV String
choice [] Int
numberI [Int]
intervalNmbrs Double
minE Double
maxE forall a b. (a -> b) -> a -> b
$
                 [String]
flines)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [String]
choices forall a b. (a -> b) -> a -> b
$ [(Double, Double)]
minMaxTuples
    else forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
choice -> String -> [String] -> IO ()
toFileStr (String
choice forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ String
file forall a. [a] -> [a] -> [a]
++ String
".new.txt") ((forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ [String]
flines)forall a. a -> [a] -> [a]
:
      ([[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> Array Int [Array Int Int]
-> String
-> [String]
-> Int
-> [Int]
-> Double
-> Double
-> [String]
-> [String]
circle2I [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs Array Int [Array Int Int]
permsV String
choice [] Int
numberI [Int]
intervalNmbrs Double
0.0 Double
0.0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ [String]
flines))) [String]
choices

compareFilesToOneCommon :: [FilePath] -> FilePath -> IO ()
compareFilesToOneCommon :: [String] -> String -> IO ()
compareFilesToOneCommon [String]
files String
file3 = do
 [(Int, [(Int, String)])]
contentss <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((\(Int
j,String
ks) -> do {String -> IO String
readFileIfAny String
ks forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
fs -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
j, forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall a b. (a -> b) -> a -> b
$ String
fs)})) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..Int
7] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
14 forall a b. (a -> b) -> a -> b
$ [String]
files
 [(Int, [(Int, String)])] -> String -> IO ()
compareF [(Int, [(Int, String)])]
contentss String
file3
   where compareF :: [(Int,[(Int,String)])] -> FilePath -> IO ()
         compareF :: [(Int, [(Int, String)])] -> String -> IO ()
compareF [(Int, [(Int, String)])]
ysss String
file3 = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Int
i -> do
          String -> IO ()
putStr String
"Please, specify which variant to use as the result, "
          String -> IO ()
putStrLn String
"maximum number is the quantity of the files from which the data is read: "
          let strs :: [(Int, String)]
strs = forall a b. (a -> b) -> [a] -> [b]
map (\(Int
j,[(Int, String)]
ks) -> (\[(Int, String)]
ts -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, String)]
ts then (Int
j,String
"")
                      else let (Int
_,String
rs) = forall a. [a] -> a
head [(Int, String)]
ts in  (Int
j,String
rs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                       forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== Int
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ [(Int, String)]
ks) [(Int, [(Int, String)])]
ysss
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
i,String
xs) -> String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
":\t" forall a. [a] -> [a] -> [a]
++ String
xs) [(Int, String)]
strs
          String
ch <- IO String
getLine
          let choice2 :: Int
choice2 = forall a. a -> Maybe a -> a
fromMaybe Int
0 (forall a. Read a => String -> Maybe a
readMaybe String
ch::Maybe Int)
          String -> [String] -> IO ()
toFileStr String
file3 ((\[(Int, String)]
us -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, String)]
us then [String
""] else [forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ [(Int, String)]
us]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== Int
choice2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ [(Int, String)]
strs)) [Int
1..]

-- | Processment without rearrangements.
circle2
 :: [[[[Sound8]]] -> [[Double]]] -- ^ Whether to use the own provided durations.
 -> Coeffs2
 -> Array Int [Array Int Int]
 -> String
 -> [String]
 -> [String]
 -> [String]
circle2 :: [[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> Array Int [Array Int Int]
-> String
-> [String]
-> [String]
-> [String]
circle2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs Array Int [Array Int Int]
permsG1 String
choice [String]
yss [String]
xss
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xss = [String]
yss
 | Bool
otherwise = [[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> Array Int [Array Int Int]
-> String
-> [String]
-> [String]
-> [String]
circle2 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs Array Int [Array Int Int]
permsG1 String
choice ([String]
yss forall a. Monoid a => a -> a -> a
`mappend` [String
ws]) [String]
tss
      where (![String]
zss,![String]
tss) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 [String]
xss
            !rs :: [String]
rs = String -> [String]
words forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ [String]
zss
            !l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
rs
            !sels :: [Sound8]
sels = String -> [Sound8]
parsey0Choice String
choice
            !frep2 :: FuncRep2 ReadyForConstructionUkr Double Double
frep2 = forall c.
Ord c =>
Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> [[[[Sound8]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> [Sound8]
-> String
-> String
-> FuncRep2 ReadyForConstructionUkr Double c
chooseMax Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs forall a. a -> a
id Coeffs2
coeffs [Sound8]
sels String
choice String
""
            !ws :: String
ws = if forall a. Ord a => a -> a -> Ordering
compare Int
l Int
3 forall a. Eq a => a -> a -> Bool
== Ordering
LT then [String] -> String
unwords [String]
rs else (\ReadyForConstructionUkr
rrrr -> forall a. a -> Maybe a -> a
fromMaybe String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadyForConstructionUkr -> Maybe String
fromReadyFCUkrS forall a b. (a -> b) -> a -> b
$ ReadyForConstructionUkr
rrrr)forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a b c. Result2 a b c -> a
line2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t2 :: * -> *) c a b.
(Foldable t2, Ord c) =>
t2 (Result2 a b c) -> Result2 a b c
maximumElR2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. FuncRep2 a b c -> a -> Result2 a b c
toResultR2 FuncRep2 ReadyForConstructionUkr Double Double
frep2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ReadyForConstructionUkr
Str) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               forall a (t :: * -> *).
(Eq a, Foldable t, InsertLeft t a, Monoid (t a),
 Monoid (t (t a))) =>
t a
-> t a
-> a
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> ([a] -> t a)
-> [Array Int Int]
-> t (t a)
-> [t a]
uniquenessVariants2GNPBL [] (forall a. [a] -> a
last [String]
rs) Char
' ' forall a. a -> a
id forall a. a -> a
id forall a. a -> a
id (forall i e. Array i e -> Int -> e
unsafeAt Array Int [Array Int Int]
permsG1 (Int
l forall a. Num a => a -> a -> a
- Int
3)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ [String]
rs

-- | Processment with rearrangements.
circle2I
 :: [[[[Sound8]]] -> [[Double]]] -- ^ Whether to use the own provided durations.
 -> Coeffs2
 -> Array Int [Array Int Int]
 -> String
 -> [String]
 -> Int
 -> [Int]
 -> Double
 -> Double
 -> [String]
 -> [String]
circle2I :: [[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> Array Int [Array Int Int]
-> String
-> [String]
-> Int
-> [Int]
-> Double
-> Double
-> [String]
-> [String]
circle2I [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs Array Int [Array Int Int]
permsG1 String
choice [String]
yss Int
numberI [Int]
intervNbrs Double
minE Double
maxE [String]
xss
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xss = [String]
yss
 | Bool
otherwise = [[[[Sound8]]] -> [[Double]]]
-> Coeffs2
-> Array Int [Array Int Int]
-> String
-> [String]
-> Int
-> [Int]
-> Double
-> Double
-> [String]
-> [String]
circle2I [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs Array Int [Array Int Int]
permsG1 String
choice ([String]
yss forall a. Monoid a => a -> a -> a
`mappend` [String
ws]) Int
numberI [Int]
intervNbrs Double
minE1 Double
maxE1 [String]
tss
      where (![String]
zss,![String]
tss) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 [String]
xss
            !w2s :: [String]
w2s = String -> [String]
words forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ [String]
tss
            !l3 :: Int
l3 = (forall a. Num a => a -> a -> a
subtract Int
3) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ [String]
w2s
            !rs :: [String]
rs = String -> [String]
words forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ [String]
zss
            !l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
rs
            !sels :: [Sound8]
sels = String -> [Sound8]
parsey0Choice String
choice
            !frep2 :: FuncRep2 ReadyForConstructionUkr Double Double
frep2 = forall c.
Ord c =>
Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> [[[[Sound8]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> [Sound8]
-> String
-> String
-> FuncRep2 ReadyForConstructionUkr Double c
chooseMax Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs (forall b c.
(RealFrac b, Integral c, Ord c) =>
b -> b -> c -> [c] -> b -> b
unsafeSwapVecIWithMaxI Double
minE Double
maxE Int
numberI [Int]
intervNbrs) Coeffs2
coeffs [Sound8]
sels String
choice String
""
            !ws :: String
ws = if forall a. Ord a => a -> a -> Ordering
compare (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
rs) Int
3 forall a. Eq a => a -> a -> Bool
== Ordering
LT then [String] -> String
unwords [String]
rs else (\ReadyForConstructionUkr
rrrr -> forall a. a -> Maybe a -> a
fromMaybe String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadyForConstructionUkr -> Maybe String
fromReadyFCUkrS forall a b. (a -> b) -> a -> b
$ ReadyForConstructionUkr
rrrr)forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a b c. Result2 a b c -> a
line2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t2 :: * -> *) c a b.
(Foldable t2, Ord c) =>
t2 (Result2 a b c) -> Result2 a b c
maximumElR2 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. FuncRep2 a b c -> a -> Result2 a b c
toResultR2 FuncRep2 ReadyForConstructionUkr Double Double
frep2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ReadyForConstructionUkr
Str) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      forall a (t :: * -> *).
(Eq a, Foldable t, InsertLeft t a, Monoid (t a),
 Monoid (t (t a))) =>
t a
-> t a
-> a
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> ([a] -> t a)
-> [Array Int Int]
-> t (t a)
-> [t a]
uniquenessVariants2GNPBL [] (forall a. [a] -> a
last [String]
rs) Char
' ' forall a. a -> a
id forall a. a -> a
id forall a. a -> a
id (forall i e. Array i e -> Int -> e
unsafeAt Array Int [Array Int Int]
permsG1 (Int
l forall a. Num a => a -> a -> a
- Int
3)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ [String]
rs
            (!Double
minE1,!Double
maxE1)
             | forall a. Ord a => a -> a -> Ordering
compare Int
l3 Int
0 forall a. Eq a => a -> a -> Bool
/= Ordering
LT =
               let !perms3 :: [Array Int Int]
perms3 = forall i e. Array i e -> Int -> e
unsafeAt Array Int [Array Int Int]
permsG1 Int
l3
                   !v4 :: [String]
v4 = forall a. [a] -> [a]
init [String]
w2s
                   !frep20 :: FuncRep2 ReadyForConstructionUkr Double Double
frep20 = forall c.
Ord c =>
Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Sound8)
-> Array Int (Sound8, [Sound8] -> Sound8)
-> Array Int (Sound8, Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int ([Sound8], Bool)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Sound8)
-> Array Int (Sound8, [Sound8])
-> Array Int (Char, Bool)
-> Array Int (Char, Bool)
-> Array Int (Sound8, Bool)
-> [[[[Sound8]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> [Sound8]
-> String
-> String
-> FuncRep2 ReadyForConstructionUkr Double c
chooseMax Array Int (Sound8, Bool)
tup1 Array Int (Sound8, Bool)
tup2 Array Int (Sound8, Bool)
tup3 Array Int (Sound8, Bool)
tup4 Array Int ([Sound8], Bool)
tup5 Array Int ([Sound8], Sound8)
tup6 Array Int (Sound8, [Sound8] -> Sound8)
tup7 Array Int (Sound8, Bool)
tup8 Array Int ([Sound8], Bool)
tup9 Array Int ([Sound8], Bool)
tup10 Array Int ([Sound8], Bool)
tup11 Array Int (Sound8, [Sound8])
tup12 Array Int (Char, Sound8)
tup13 Array Int (Sound8, [Sound8])
tup14 Array Int (Char, Bool)
tup15 Array Int (Char, Bool)
tup16 Array Int (Sound8, Bool)
tup17 [[[[Sound8]]] -> [[Double]]]
syllableDurationsDs forall a. a -> a
id Coeffs2
coeffs [Sound8]
sels String
choice String
"" in forall a (t :: * -> *).
(Ord a, InsertLeft t a, Monoid (t a)) =>
t a -> (a, a)
minMax11C forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. FuncRep2 a b c -> a -> b
toPropertiesF'2 FuncRep2 ReadyForConstructionUkr Double Double
frep20 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ReadyForConstructionUkr
Str) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      forall a (t :: * -> *).
(Eq a, Foldable t, InsertLeft t a, Monoid (t a),
 Monoid (t (t a))) =>
t a
-> t a
-> a
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> ([a] -> t a)
-> [Array Int Int]
-> t (t a)
-> [t a]
uniquenessVariants2GNPBL [] (forall a. [a] -> a
last [String]
w2s) Char
' ' forall a. a -> a
id forall a. a -> a
id forall a. a -> a
id [Array Int Int]
perms3 forall a b. (a -> b) -> a -> b
$ [String]
v4
             | Bool
otherwise = (Double
0.0,Double
0.0)

-- | Prints every element from the structure on the new line to the file. Uses 'appendFile' function inside. Is taken from
-- the Languages.UniquenessPeriods.Vector.General.DebugG module from the @phonetic-languages-general@ package.
toFileStr ::
  FilePath -- ^ The 'FilePath' to the file to be written in the 'AppendMode' (actually appended with) the information output.
  -> [String] -- ^ Each element is appended on the new line to the file.
  -> IO ()
toFileStr :: String -> [String] -> IO ()
toFileStr String
file [String]
xss = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\String
xs -> String -> String -> IO ()
appendFile String
file (String
xs forall a. Monoid a => a -> a -> a
`mappend` String
newLineEnding)) [String]
xss