packages feed

phonetic-languages-simplified-examples-array-0.20.0.0: Phonetic/Languages/Lines.hs

{-# 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.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 fileDu pairwisePermutations (gr1,gr2) coeffs numericArgs choices0 numberI file = do
  syllableDurationsDs <- readSyllableDurations fileDu
  let choices = map (filter (/='a')) choices0
  contents <- readFile file
  let !permsV
        | pairwisePermutations == P 2 = genPairwisePermutationsArrLN 10
        | pairwisePermutations == P 1 = genElementaryPermutationsArrLN1 10
        | otherwise = genPermutationsArrL
      !flines
        | gr1 == 0 = fLinesN (if pairwisePermutations /= P 0 then 10 else 7) 0 contents
        | otherwise = prepareGrowTextMN gr1 gr2 . unlines . fLinesN (if pairwisePermutations /= P 0 then 10 else 7) 0 $ contents
      !lasts = map (\ts -> if null . words $ ts then [] else last . words $ ts) flines
  if compare numberI 2 == LT then
    mapM_ (\choice -> toFileStr (choice ++ "." ++ file ++ ".new.txt") (circle2 syllableDurationsDs coeffs permsV choice [] $ flines)) choices
  else do
    let !intervalNmbrs = (\vs -> if null vs then [numberI] else nub vs) . sort . filter (<= numberI) .
           map (\t -> fromMaybe numberI (readMaybe t::Maybe Int)) . drop 2 $ numericArgs
        !us = words . concat . take 1 $ flines
        !l2 = (subtract 3) . length $ us
    if compare l2 0 /= LT then do
      let !perms2 = unsafeAt permsV $ l2
          minMaxTuples = let !frep20Zip = zip choices . map (\choice -> chooseMax tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 syllableDurationsDs id coeffs choice "") $ choices in
            map (\(_,frep20) -> minMax11C . map (toPropertiesF'2 frep20 . Str) .
              uniquenessVariants2GNPBL [] (concat . take 1 $ lasts) ' ' id id id perms2 . init $ us) frep20Zip
      mapM_ (\(choice, (minE,maxE)) -> toFileStr (choice ++ "." ++ file ++ ".new.txt")
              (circle2I syllableDurationsDs coeffs permsV choice [] numberI intervalNmbrs minE maxE $
                 flines)) . zip choices $ minMaxTuples
    else mapM_ (\choice -> toFileStr (choice ++ "." ++ file ++ ".new.txt") ((concat . take 1 $ flines):
      (circle2I syllableDurationsDs coeffs permsV choice [] numberI intervalNmbrs 0.0 0.0 . drop 1 $ flines))) choices

compareFilesToOneCommon :: [FilePath] -> FilePath -> IO ()
compareFilesToOneCommon files file3 = do
 contentss <- mapM ((\(j,ks) -> do {readFileIfAny ks >>= \fs -> return (j, zip [1..] . lines $ fs)})) . zip [1..7] . take 7 $ files
 compareF contentss file3
   where compareF :: [(Int,[(Int,String)])] -> FilePath -> IO ()
         compareF ysss file3 = mapM_ (\i -> do
          putStr "Please, specify which variant to use as the result, "
          putStrLn "maximum number is the quantity of the files from which the data is read: "
          let strs = map (\(j,ks) -> (\ts -> if null ts then (j,"")
                      else let (_,rs) = head ts in  (j,rs)) .
                       filter ((== i) . fst) $ ks) ysss
          mapM_ (\(i,xs) -> putStrLn $ show i ++ ":\t" ++ xs) strs
          ch <- getLine
          let choice2 = fromMaybe 0 (readMaybe ch::Maybe Int)
          toFileStr file3 ((\us -> if null us then [""] else [snd . head $ us]) . filter ((== choice2) . fst) $ strs)) [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 syllableDurationsDs coeffs permsG1 choice yss xss
 | null xss = yss
 | otherwise = circle2 syllableDurationsDs coeffs permsG1 choice (yss `mappend` [ws]) tss
      where (!zss,!tss) = splitAt 1 xss
            !rs = words . concat $ zss
            !l = length rs
            !frep2 = chooseMax tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 syllableDurationsDs id coeffs choice ""
            !ws = if compare l 3 == LT then unwords rs else (\rrrr -> fromMaybe "" . fromReadyFCUkrS $ rrrr).  line2 . maximumElR2 . map (toResultR2 frep2 . Str) .
               uniquenessVariants2GNPBL [] (last rs) ' ' id id id (unsafeAt permsG1 (l - 3)) . init $ 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 syllableDurationsDs coeffs permsG1 choice yss numberI intervNbrs minE maxE xss
 | null xss = yss
 | otherwise = circle2I syllableDurationsDs coeffs permsG1 choice (yss `mappend` [ws]) numberI intervNbrs minE1 maxE1 tss
      where (!zss,!tss) = splitAt 1 xss
            !w2s = words . concat . take 1 $ tss
            !l3 = (subtract 3) . length $ w2s
            !rs = words . concat $ zss
            !l = length rs
            !frep2 = chooseMax tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 syllableDurationsDs (unsafeSwapVecIWithMaxI minE maxE numberI intervNbrs) coeffs choice ""
            !ws = if compare (length rs) 3 == LT then unwords rs else (\rrrr -> fromMaybe "" . fromReadyFCUkrS $ rrrr).  line2 . maximumElR2 .
                    map (toResultR2 frep2 . Str) .
                      uniquenessVariants2GNPBL [] (last rs) ' ' id id id (unsafeAt permsG1 (l - 3)) . init $ rs
            (!minE1,!maxE1)
             | compare l3 0 /= LT =
               let !perms3 = unsafeAt permsG1 l3
                   !v4 = init w2s
                   !frep20 = chooseMax tup1 tup2 tup3 tup4 tup5 tup6 tup7 tup8 tup9 tup10 tup11 tup12 tup13 tup14 tup15 tup16 tup17 syllableDurationsDs id coeffs choice "" in minMax11C . map (toPropertiesF'2 frep20 . Str) .
                      uniquenessVariants2GNPBL [] (last w2s) ' ' id id id perms3 $ v4
             | otherwise = (0.0,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 file xss = mapM_ (\xs -> appendFile file (xs `mappend` newLineEnding)) xss