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

-- |
-- Module      :  Phonetic.Languages.Lines
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- 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 System.IO
import Data.SubG
import Data.MinMax.Preconditions
import GHC.Arr
import Data.List (sort,nub,zip,zip3,zip4,zip5,zip6,zip7)
import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2
import Phonetic.Languages.Simplified.StrictVG.Base
import Phonetic.Languages.Permutations.Arr
import Phonetic.Languages.Permutations.ArrMini
import Phonetic.Languages.Filters (unsafeSwapVecIWithMaxI)
import Text.Read (readMaybe)
import Data.Maybe (fromMaybe)
import Phonetic.Languages.Simplified.DataG.Base
import Data.Char (isDigit)
import Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2
import Data.Monoid (mappend)
import Phonetic.Languages.Common
import Interpreter.StringConversion
import qualified Languages.Phonetic.Ukrainian.Syllable.Arr as S (UZPP2)
import Phonetic.Languages.Ukrainian.PrepareText (prepareGrowTextMN, prepareTuneTextMN,isSpC,isUkrainianL)
import Phonetic.Languages.Simplified.Array.Ukrainian.ReadProperties

{-| @ since 0.5.0.0 -- The meaning of the first command line argument (and 'Coeffs2' here everywhere in the module)
depends on the 'String' argument -- whether it starts with \'w\', \'x\' or otherwise. In the first case it represents
the k1 and k2 coefficients (default ones equal to 2.0 and 0.125) for the functions from the Rhythmicity.TwoFourth module.
Otherwise, it is used for the functions to specify the level of emphasizing the two-based and three-based periods
(the default values here are 1.0 both).
@ since 0.6.0.0 -- There is also the possibility to use \'line growing\' that is to use the 'prepereGrowTextMN' function
with the 'Int' arguments from the first argument tuple. This allows to rearrange the given text and then
to rewrite it.
Besides there are new lines of the arguments for the 'String' argument that can begin with \"c\", \"s\", \"t\",
\"u\", \"v\", \"C\", \"N\", \"S\", \"T\", \"U\", \"V\", \"W\", \"X\", \"Y\" and \"Z\" letters. For more information, please, refer to the 'Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2.rhythmicity'.
@ 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.
 -> 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)
 -> Coeffs2
 -> [String]
 -> [String]
 -> Int
 -> FilePath -- ^ The file with the text in Ukranian to be rewritten.
 -> IO ()
generalProcessment :: FilePath
-> Bool
-> (Int, Int)
-> Coeffs2
-> [FilePath]
-> [FilePath]
-> Int
-> FilePath
-> IO ()
generalProcessment FilePath
fileDu Bool
pairwisePermutations (Int
gr1,Int
gr2) Coeffs2
coeffs [FilePath]
numericArgs [FilePath]
choices Int
numberI FilePath
file = do
  [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs <- FilePath -> IO [[[[UZPP2]]] -> [[Double]]]
readSyllableDurations FilePath
fileDu
  FilePath
contents <- FilePath -> IO FilePath
readFile FilePath
file
  let !permsV :: Array Int [Array Int Int]
permsV
        | Bool
pairwisePermutations = Int -> Array Int [Array Int Int]
genPairwisePermutationsArrLN Int
10
        | Bool
otherwise = Array Int [Array Int Int]
genPermutationsArrL
      !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
0 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
0 (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
contents
      !lasts :: [FilePath]
lasts = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
ts -> if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([FilePath] -> Bool)
-> (FilePath -> [FilePath]) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words (FilePath -> Bool) -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath
ts then [] else [FilePath] -> FilePath
forall a. [a] -> a
last ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
ts) [FilePath]
flines
  if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
numberI Int
2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then
    (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\FilePath
choice -> FilePath -> [FilePath] -> IO ()
toFileStr (FilePath
choice FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".new.txt") ([[[[UZPP2]]] -> [[Double]]]
-> Coeffs2
-> Array Int [Array Int Int]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
circle2 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs Array Int [Array Int Int]
permsV FilePath
choice [] ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
flines)) [FilePath]
choices
  else do
    let !intervalNmbrs :: [Int]
intervalNmbrs = (\[Int]
vs -> if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
vs then [Int
numberI] else [Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub [Int]
vs) ([Int] -> [Int]) -> ([FilePath] -> [Int]) -> [FilePath] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> ([FilePath] -> [Int]) -> [FilePath] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
numberI) ([Int] -> [Int]) -> ([FilePath] -> [Int]) -> [FilePath] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
           (FilePath -> Int) -> [FilePath] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
t -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
numberI (FilePath -> Maybe Int
forall a. Read a => FilePath -> Maybe a
readMaybe FilePath
t::Maybe Int)) ([FilePath] -> [Int])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
drop Int
2 ([FilePath] -> [Int]) -> [FilePath] -> [Int]
forall a b. (a -> b) -> a -> b
$ [FilePath]
numericArgs
        !us :: [FilePath]
us = FilePath -> [FilePath]
words (FilePath -> [FilePath])
-> ([FilePath] -> FilePath) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([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
1 ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
flines
        !l2 :: Int
l2 = (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
3) (Int -> Int) -> ([FilePath] -> Int) -> [FilePath] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([FilePath] -> Int) -> [FilePath] -> Int
forall a b. (a -> b) -> a -> b
$ [FilePath]
us
    if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l2 Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT then do
      let !perms2 :: [Array Int Int]
perms2 = Array Int [Array Int Int] -> Int -> [Array Int Int]
forall i e. Array i e -> Int -> e
unsafeAt Array Int [Array Int Int]
permsV (Int -> [Array Int Int]) -> Int -> [Array Int Int]
forall a b. (a -> b) -> a -> b
$ Int
l2
          minMaxTuples :: [(Double, Double)]
minMaxTuples = let !frep20Zip :: [(FilePath, FuncRep2 FilePath Double Double)]
frep20Zip = [FilePath]
-> [FuncRep2 FilePath Double Double]
-> [(FilePath, FuncRep2 FilePath Double Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
choices ([FuncRep2 FilePath Double Double]
 -> [(FilePath, FuncRep2 FilePath Double Double)])
-> ([FilePath] -> [FuncRep2 FilePath Double Double])
-> [FilePath]
-> [(FilePath, FuncRep2 FilePath Double Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FuncRep2 FilePath Double Double)
-> [FilePath] -> [FuncRep2 FilePath Double Double]
forall a b. (a -> b) -> [a] -> [b]
map ([[[[UZPP2]]] -> [[Double]]]
-> (Double -> Double)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double Double
forall c.
Ord c =>
[[[[UZPP2]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double c
chooseMax [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs Double -> Double
forall a. a -> a
id Coeffs2
coeffs) ([FilePath] -> [(FilePath, FuncRep2 FilePath Double Double)])
-> [FilePath] -> [(FilePath, FuncRep2 FilePath Double Double)]
forall a b. (a -> b) -> a -> b
$ [FilePath]
choices in
            ((FilePath, FuncRep2 FilePath Double Double) -> (Double, Double))
-> [(FilePath, FuncRep2 FilePath Double Double)]
-> [(Double, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\(FilePath
choice,FuncRep2 FilePath Double Double
frep20) -> [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 -> b
toPropertiesF' FuncRep2 FilePath Double Double
frep20) ([FilePath] -> [Double])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
              FilePath
-> FilePath
-> 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))) =>
t a
-> t a
-> a
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> ([a] -> t a)
-> [Array Int Int]
-> t (t a)
-> [t a]
uniquenessVariants2GNPBL [] ([FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([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
1 ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
lasts) 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]
perms2 ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. [a] -> [a]
init ([FilePath] -> (Double, Double)) -> [FilePath] -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ [FilePath]
us) [(FilePath, FuncRep2 FilePath Double Double)]
frep20Zip
      ((FilePath, (Double, Double)) -> IO ())
-> [(FilePath, (Double, Double))] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(FilePath
choice, (Double
minE,Double
maxE)) -> FilePath -> [FilePath] -> IO ()
toFileStr (FilePath
choice FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".new.txt")
              ([[[[UZPP2]]] -> [[Double]]]
-> Coeffs2
-> Array Int [Array Int Int]
-> FilePath
-> [FilePath]
-> Int
-> [Int]
-> Double
-> Double
-> [FilePath]
-> [FilePath]
circle2I [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs Array Int [Array Int Int]
permsV FilePath
choice [] Int
numberI [Int]
intervalNmbrs Double
minE Double
maxE ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$
                 [FilePath]
flines)) ([(FilePath, (Double, Double))] -> IO ())
-> ([(Double, Double)] -> [(FilePath, (Double, Double))])
-> [(Double, Double)]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [(Double, Double)] -> [(FilePath, (Double, Double))]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
choices ([(Double, Double)] -> IO ()) -> [(Double, Double)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [(Double, Double)]
minMaxTuples
    else (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\FilePath
choice -> FilePath -> [FilePath] -> IO ()
toFileStr (FilePath
choice FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".new.txt") (([FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([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
1 ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
flines)FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:
      ([[[[UZPP2]]] -> [[Double]]]
-> Coeffs2
-> Array Int [Array Int Int]
-> FilePath
-> [FilePath]
-> Int
-> [Int]
-> Double
-> Double
-> [FilePath]
-> [FilePath]
circle2I [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs Array Int [Array Int Int]
permsV FilePath
choice [] Int
numberI [Int]
intervalNmbrs Double
0.0 Double
0.0 ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
drop Int
1 ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
flines))) [FilePath]
choices

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

-- | Processment without rearrangements.
circle2
 :: [[[[S.UZPP2]]] -> [[Double]]] -- ^ Whether to use the own provided durations.
 -> Coeffs2
 -> Array Int [Array Int Int]
 -> String
 -> [String]
 -> [String]
 -> [String]
circle2 :: [[[[UZPP2]]] -> [[Double]]]
-> Coeffs2
-> Array Int [Array Int Int]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
circle2 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs Array Int [Array Int Int]
permsG1 FilePath
choice [FilePath]
yss [FilePath]
xss
 | [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
xss = [FilePath]
yss
 | Bool
otherwise = [[[[UZPP2]]] -> [[Double]]]
-> Coeffs2
-> Array Int [Array Int Int]
-> FilePath
-> [FilePath]
-> [FilePath]
-> [FilePath]
circle2 [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs Array Int [Array Int Int]
permsG1 FilePath
choice ([FilePath]
yss [FilePath] -> [FilePath] -> [FilePath]
forall a. Monoid a => a -> a -> a
`mappend` [FilePath
ws]) [FilePath]
tss
      where (![FilePath]
zss,![FilePath]
tss) = Int -> [FilePath] -> ([FilePath], [FilePath])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 [FilePath]
xss
            !rs :: [FilePath]
rs = FilePath -> [FilePath]
words (FilePath -> [FilePath])
-> ([FilePath] -> FilePath) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
zss
            !l :: Int
l = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
rs
            !frep2 :: FuncRep2 FilePath Double Double
frep2 = [[[[UZPP2]]] -> [[Double]]]
-> (Double -> Double)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double Double
forall c.
Ord c =>
[[[[UZPP2]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double c
chooseMax [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs Double -> Double
forall a. a -> a
id Coeffs2
coeffs FilePath
choice
            !ws :: FilePath
ws = if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l Int
3 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then [FilePath] -> FilePath
unwords [FilePath]
rs else Result [] Char Double Double -> FilePath
forall (t :: * -> *) a b c. Result t a b c -> t a
line (Result [] Char Double Double -> FilePath)
-> ([FilePath] -> Result [] Char Double Double)
-> [FilePath]
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Result [] Char Double Double] -> Result [] Char Double Double
forall (t2 :: * -> *) c (t :: * -> *) a b.
(Foldable t2, Ord c) =>
t2 (Result t a b c) -> Result t a b c
maximumElR ([Result [] Char Double Double] -> Result [] Char Double Double)
-> ([FilePath] -> [Result [] Char Double Double])
-> [FilePath]
-> Result [] Char Double Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Result [] Char Double Double)
-> [FilePath] -> [Result [] Char Double Double]
forall a b. (a -> b) -> [a] -> [b]
map (FuncRep2 FilePath Double Double
-> FilePath -> Result [] Char Double Double
forall (t :: * -> *) a b c.
FuncRep2 (t a) b c -> t a -> Result t a b c
toResultR FuncRep2 FilePath Double Double
frep2) ([FilePath] -> [Result [] Char Double Double])
-> ([FilePath] -> [FilePath])
-> [FilePath]
-> [Result [] Char Double Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               FilePath
-> FilePath
-> 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))) =>
t a
-> t a
-> a
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> ([a] -> t a)
-> [Array Int Int]
-> t (t a)
-> [t a]
uniquenessVariants2GNPBL [] ([FilePath] -> FilePath
forall a. [a] -> a
last [FilePath]
rs) Char
' ' FilePath -> FilePath
forall a. a -> a
id [FilePath] -> [FilePath]
forall a. a -> a
id FilePath -> FilePath
forall a. a -> a
id (Array Int [Array Int Int] -> Int -> [Array Int Int]
forall i e. Array i e -> Int -> e
unsafeAt Array Int [Array Int Int]
permsG1 (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3)) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. [a] -> [a]
init ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
rs

-- | Processment with rearrangements.
circle2I
 :: [[[[S.UZPP2]]] -> [[Double]]] -- ^ Whether to use the own provided durations.
 -> Coeffs2
 -> Array Int [Array Int Int]
 -> String
 -> [String]
 -> Int
 -> [Int]
 -> Double
 -> Double
 -> [String]
 -> [String]
circle2I :: [[[[UZPP2]]] -> [[Double]]]
-> Coeffs2
-> Array Int [Array Int Int]
-> FilePath
-> [FilePath]
-> Int
-> [Int]
-> Double
-> Double
-> [FilePath]
-> [FilePath]
circle2I [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs Array Int [Array Int Int]
permsG1 FilePath
choice [FilePath]
yss Int
numberI [Int]
intervNbrs Double
minE Double
maxE [FilePath]
xss
 | [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
xss = [FilePath]
yss
 | Bool
otherwise = [[[[UZPP2]]] -> [[Double]]]
-> Coeffs2
-> Array Int [Array Int Int]
-> FilePath
-> [FilePath]
-> Int
-> [Int]
-> Double
-> Double
-> [FilePath]
-> [FilePath]
circle2I [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs Coeffs2
coeffs Array Int [Array Int Int]
permsG1 FilePath
choice ([FilePath]
yss [FilePath] -> [FilePath] -> [FilePath]
forall a. Monoid a => a -> a -> a
`mappend` [FilePath
ws]) Int
numberI [Int]
intervNbrs Double
minE1 Double
maxE1 [FilePath]
tss
      where (![FilePath]
zss,![FilePath]
tss) = Int -> [FilePath] -> ([FilePath], [FilePath])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 [FilePath]
xss
            !w2s :: [FilePath]
w2s = FilePath -> [FilePath]
words (FilePath -> [FilePath])
-> ([FilePath] -> FilePath) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([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
1 ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
tss
            !l3 :: Int
l3 = (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
3) (Int -> Int) -> ([FilePath] -> Int) -> [FilePath] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([FilePath] -> Int) -> [FilePath] -> Int
forall a b. (a -> b) -> a -> b
$ [FilePath]
w2s
            !rs :: [FilePath]
rs = FilePath -> [FilePath]
words (FilePath -> [FilePath])
-> ([FilePath] -> FilePath) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
zss
            !l :: Int
l = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
rs
            !frep2 :: FuncRep2 FilePath Double Double
frep2 = [[[[UZPP2]]] -> [[Double]]]
-> (Double -> Double)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double Double
forall c.
Ord c =>
[[[[UZPP2]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double c
chooseMax [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs (Double -> Double -> Int -> [Int] -> Double -> Double
forall b c.
(RealFrac b, Integral c) =>
b -> b -> c -> [c] -> b -> b
unsafeSwapVecIWithMaxI Double
minE Double
maxE Int
numberI [Int]
intervNbrs) Coeffs2
coeffs FilePath
choice
            !ws :: FilePath
ws = if Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
rs) Int
3 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT then [FilePath] -> FilePath
unwords [FilePath]
rs else Result [] Char Double Double -> FilePath
forall (t :: * -> *) a b c. Result t a b c -> t a
line (Result [] Char Double Double -> FilePath)
-> ([FilePath] -> Result [] Char Double Double)
-> [FilePath]
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Result [] Char Double Double] -> Result [] Char Double Double
forall (t2 :: * -> *) c (t :: * -> *) a b.
(Foldable t2, Ord c) =>
t2 (Result t a b c) -> Result t a b c
maximumElR ([Result [] Char Double Double] -> Result [] Char Double Double)
-> ([FilePath] -> [Result [] Char Double Double])
-> [FilePath]
-> Result [] Char Double Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    (FilePath -> Result [] Char Double Double)
-> [FilePath] -> [Result [] Char Double Double]
forall a b. (a -> b) -> [a] -> [b]
map (FuncRep2 FilePath Double Double
-> FilePath -> Result [] Char Double Double
forall (t :: * -> *) a b c.
FuncRep2 (t a) b c -> t a -> Result t a b c
toResultR FuncRep2 FilePath Double Double
frep2) ([FilePath] -> [Result [] Char Double Double])
-> ([FilePath] -> [FilePath])
-> [FilePath]
-> [Result [] Char Double Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      FilePath
-> FilePath
-> 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))) =>
t a
-> t a
-> a
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> ([a] -> t a)
-> [Array Int Int]
-> t (t a)
-> [t a]
uniquenessVariants2GNPBL [] ([FilePath] -> FilePath
forall a. [a] -> a
last [FilePath]
rs) Char
' ' FilePath -> FilePath
forall a. a -> a
id [FilePath] -> [FilePath]
forall a. a -> a
id FilePath -> FilePath
forall a. a -> a
id (Array Int [Array Int Int] -> Int -> [Array Int Int]
forall i e. Array i e -> Int -> e
unsafeAt Array Int [Array Int Int]
permsG1 (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3)) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. [a] -> [a]
init ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
rs
            (!Double
minE1,!Double
maxE1)
             | Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
l3 Int
0 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT =
               let !perms3 :: [Array Int Int]
perms3 = Array Int [Array Int Int] -> Int -> [Array Int Int]
forall i e. Array i e -> Int -> e
unsafeAt Array Int [Array Int Int]
permsG1 Int
l3
                   !v4 :: [FilePath]
v4 = [FilePath] -> [FilePath]
forall a. [a] -> [a]
init [FilePath]
w2s
                   !frep20 :: FuncRep2 FilePath Double Double
frep20 = [[[[UZPP2]]] -> [[Double]]]
-> (Double -> Double)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double Double
forall c.
Ord c =>
[[[[UZPP2]]] -> [[Double]]]
-> (Double -> c)
-> Coeffs2
-> FilePath
-> FuncRep2 FilePath Double c
chooseMax [[[[UZPP2]]] -> [[Double]]]
syllableDurationsDs Double -> Double
forall a. a -> a
id Coeffs2
coeffs FilePath
choice in [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 -> b
toPropertiesF' FuncRep2 FilePath Double Double
frep20) ([FilePath] -> [Double])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                      FilePath
-> FilePath
-> 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))) =>
t a
-> t a
-> a
-> (t a -> [a])
-> (t (t a) -> [[a]])
-> ([a] -> t a)
-> [Array Int Int]
-> t (t a)
-> [t a]
uniquenessVariants2GNPBL [] ([FilePath] -> FilePath
forall a. [a] -> a
last [FilePath]
w2s) 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]
perms3 ([FilePath] -> (Double, Double)) -> [FilePath] -> (Double, Double)
forall a b. (a -> b) -> a -> b
$ [FilePath]
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 :: FilePath -> [FilePath] -> IO ()
toFileStr FilePath
file [FilePath]
xss = (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\FilePath
xs -> FilePath -> FilePath -> IO ()
appendFile FilePath
file (FilePath
xs FilePath -> FilePath -> FilePath
forall a. Monoid a => a -> a -> a
`mappend` FilePath
newLineEnding)) [FilePath]
xss