{-# OPTIONS_GHC -threaded -rtsopts #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns #-}
-- |
-- Module : Phonetic.Languages.General.Lines
-- Copyright : (c) OleksandrZhabenko 2020-2021
-- License : MIT
-- Stability : Experimental
-- Maintainer : olexandr543@yahoo.com
--
-- Library module that contains functions earlier used by the rewritePoemG3
-- executable for the Ukrainian language (see: https://hackage.haskell.org/package/phonetic-languages-simplified-examples-array).
-- 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).
-- Is rewritten from the Phonetic.Languages.Lines module from the
-- @phonetic-languages-simplified-examples-array@ package.
module Phonetic.Languages.General.Lines where
import Phonetic.Languages.General.DeEnCoding (newLineEnding)
import System.IO
import Data.SubG
import Data.MinMax.Preconditions
import GHC.Arr
import Data.List (sort,nub)
import Phonetic.Languages.Array.General.PropertiesSyllablesG2
import Phonetic.Languages.Simplified.StrictVG.Base
import Phonetic.Languages.Permutations.Arr
import Phonetic.Languages.Filters (unsafeSwapVecIWithMaxI)
import Text.Read (readMaybe)
import Data.Maybe (fromMaybe)
import Data.Phonetic.Languages.PrepareText
import Data.Phonetic.Languages.Base
import Data.Phonetic.Languages.Syllables
import Phonetic.Languages.Simplified.DataG.Base
import Data.Char (isDigit)
import Phonetic.Languages.Simplified.Array.General.FuncRep2RelatedG2
import Data.Monoid (mappend)
import Phonetic.Languages.General.Common
generalProcessment
:: 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 -> ([[[PRS]]] -> [[Double]]))-- ^ 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@.
-> [([[[PRS]]] -> [[Double]])] -- ^ A list of 4 different functions that specifies the syllables durations, analogues of the
-- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The last one must be probably the most
-- exact one and, therefore, the default one.
-> Concatenations -- ^ Data used to concatenate 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
-> Coeffs2
-> [String]
-> 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 (that is the default one). Specifies the applied properties
-- to get the result. The \"z\"-line uses \'F\' functions.
-> Int
-> FilePath
-> IO ()
generalProcessment wrs ks arr gs h rs ysss xs js vs coeffs numericArgs choice numberI file = do
contents <- readFile file
let !permsV = genPermutationsArrL
!flines = fLines ysss xs js vs 0 contents
!lasts = map (\ts -> if null . words $ ts then [] else last . words $ ts) flines
if compare numberI 2 == LT then toFileStr (file ++ ".new.txt") (circle2 wrs ks arr gs js vs h rs coeffs permsV choice [] $ flines)
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
(!minE,!maxE) = let !frep20 = chooseMax wrs ks arr gs js vs id h coeffs rs choice in minMax11C . map (toPropertiesF' frep20) .
uniquenessVariants2GNPBL [] (concat . take 1 $ lasts) ' ' id id id perms2 . init $ us
toFileStr (file ++ ".new.txt") (circle2I wrs ks arr gs js vs h rs coeffs permsV choice [] numberI intervalNmbrs minE maxE $ flines)
else toFileStr (file ++ ".new.txt") ((concat . take 1 $ flines):(circle2I wrs ks arr gs js vs h rs coeffs permsV choice [] numberI intervalNmbrs 0.0 0.0 . drop 1 $ flines))
compareFilesToOneCommon :: FilePath -> FilePath -> FilePath -> IO ()
compareFilesToOneCommon file1 file2 file3 = do
contents1 <- fmap lines . readFile $ file1
contents2 <- fmap lines . readFile $ file2
let linesZipped = zip contents1 contents2
compare2F linesZipped file3
where compare2F :: [(String,String)] -> FilePath -> IO ()
compare2F yss file3 = mapM_ (\xs -> do
putStrLn "Please, specify which variant to use as the result, either 1 or 2: "
putStrLn $ "1:\t" ++ fst xs
putStrLn $ "2:\t" ++ snd xs
ch <- getLine
let choice2 = fromMaybe 0 (readMaybe ch::Maybe Int)
case choice2 of
1 -> toFileStr file3 [fst xs]
2 -> toFileStr file3 [snd xs]
_ -> toFileStr file3 [""]) yss
-- | Processment without rearrangements.
circle2
:: 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 -> ([[[PRS]]] -> [[Double]]))-- ^ 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@.
-> [([[[PRS]]] -> [[Double]])] -- ^ A list of 4 different functions that specifies the syllables durations, analogues of the
-- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The last one must be probably the most
-- exact one and, therefore, the default one.
-> Coeffs2
-> Array Int [Array Int Int] -- ^ A permutations array of indices.
-> 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 (that is the default one). Specifies the applied properties
-- to get the result. The \"z\"-line uses \'F\' functions.
-> [String]
-> [String]
-> [String]
circle2 wrs ks arr gs js vs h qs coeffs permsG1 choice yss xss
| null xss = yss
| otherwise = circle2 wrs ks arr gs js vs h qs coeffs permsG1 choice (yss `mappend` [ws]) tss
where (!zss,!tss) = splitAt 1 xss
!rs = words . concat $ zss
!l = length rs
!frep2 = chooseMax wrs ks arr gs js vs id h coeffs qs choice
!ws = if compare l 3 == LT then unwords rs else line . maximumElR . map (toResultR frep2) .
uniquenessVariants2GNPBL [] (last rs) ' ' id id id (unsafeAt permsG1 (l - 3)) . init $ rs
-- | Processment with rearrangements.
circle2I
:: 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 -> ([[[PRS]]] -> [[Double]])) -- ^ 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@.
-> [([[[PRS]]] -> [[Double]])]-- ^ A list of 4 different functions that specifies the syllables durations, analogues of the
-- syllableDurationsD functions from the @ukrainian-phonetics-basics-array@ package. The last one must be probably the most
-- exact one and, therefore, the default one.
-> Coeffs2
-> Array Int [Array Int Int] -- ^ A permutations array of indices.
-> 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 (that is the default one). Specifies the applied properties
-- to get the result. The \"z\"-line uses \'F\' functions.
-> [String]
-> Int
-> [Int]
-> Double
-> Double
-> [String]
-> [String]
circle2I wrs ks arr gs js vs h qs coeffs permsG1 choice yss numberI intervNbrs minE maxE xss
| null xss = yss
| otherwise = circle2I wrs ks arr gs js vs h qs 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 wrs ks arr gs js vs (unsafeSwapVecIWithMaxI minE maxE numberI intervNbrs) h coeffs qs choice
!ws = if compare (length rs) 3 == LT then unwords rs else line . maximumElR . map (toResultR frep2) .
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 wrs ks arr gs js vs id h coeffs qs choice in minMax11C . map (toPropertiesF' frep20) .
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