-- |
-- Module : Main
-- Copyright : (c) OleksandrZhabenko 2020
-- License : MIT
-- Stability : Experimental
-- Maintainer : olexandr543@yahoo.com
--
-- 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).
{-# OPTIONS_GHC -threaded -rtsopts #-}
{-# LANGUAGE BangPatterns, FlexibleContexts #-}
module Main where
import Data.SubG
import Control.Parallel.Strategies
import qualified Data.Vector as VB
import Data.List (sort)
import Languages.UniquenessPeriods.Vector.PropertiesG
import Languages.UniquenessPeriods.Vector.General.DebugG
import Languages.UniquenessPeriods.Vector.StrictVG
import Languages.UniquenessPeriods.Vector.Filters (unsafeSwapVecIWithMaxI)
import Text.Read (readMaybe)
import Data.Maybe (fromMaybe)
import Melodics.ByteString.Ukrainian (isUkrainianL)
import System.Environment
import Languages.Phonetic.Ukrainian.PrepareText
import Languages.UniquenessPeriods.Vector.DataG
import Languages.UniquenessPeriods.Vector.AuxiliaryG
import Data.Char (isDigit,isAlpha)
import Languages.UniquenessPeriods.Vector.FuncRepRelatedG
-- | The function allows to rewrite the Ukrainian text in the file given as the first command line argument to a new file. In between, it is rewritten
-- so that every last word on the lines is preserved at its position, and the rest of the line is rearranged using the specified other command line
-- arguments. They are general for the whole program. The first command line argument is a FilePath to the file with a Ukrainian text to be rewritten.
-- The second one is a variant of the metrics (\"properties\") used to evaluate the variants.
-- The further command line arguments are: the number of the intervals and the numbers of the intervals
-- that are swapped with the maximum one so that they are available for further usage by the program. See documentation for @uniqueness-periods-vector-filters@
-- package
-- 'https://hackage.haskell.org/package/uniqueness-periods-vector-filters'
--
main :: IO ()
main = do
args <- getArgs
let !numericArgs = filter (all isDigit) . drop 2 $ args
!choice = concat . drop 1 . take 2 $ args
!numberI = fromMaybe 1 (readMaybe (concat . take 1 $ numericArgs)::Maybe Int)
!file = concat . take 1 $ args
!permsV = VB.force genPermutationsV
contents <- readFile file
let !flines = fLines contents
!lasts = map (\ts -> if null . words $ ts then [] else last . words $ ts) flines
!l = (subtract 3) . length . words . concat . take 1 $ flines
!whspss = VB.fromList " 01-"
if compare numberI 2 == LT then do
let !zs = if compare l 0 == LT then concat . take 1 $ flines else VB.toList . lastFrom3 . headU2 . fst . get22 .
uniqNProperties2GN ' ' whspss id id id (VB.unsafeIndex permsV l) (PA VB.empty (VB.fromList . concat . take 1 $ lasts)) 1 1 (VB.singleton oneProperty) (chooseMax choice) . VB.fromList . unwords . init . words . concat . take 1 $ flines
toFileStr (file ++ ".new.txt") (zs:(noDoubleWords . circle2 permsV (concat . take 1 $ lasts) choice [] . drop 1 $ flines))
else do
let !intervalNmbrs = (\vs -> if null vs then VB.singleton numberI else VB.uniq . VB.fromList $ 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 = VB.force . VB.unsafeIndex permsV $ l2
!v = if compare l2 0 == LT then VB.empty else VB.fromList . unwords . init $ us
!v2 = subG whspss v
(!maxE,!minE) = runEval (parTuple2 rpar rpar ((\k -> if k == 0.0 then 1.0 else k) . (\rs -> if null rs then 0.0 else head rs) . firstFrom3 .
maximumElBy 1 (VB.singleton oneProperty) $ UL2 (VB.empty,uniquenessVariants2GNB ' ' id id id perms2 (VB.singleton oneProperty) (chooseMax choice) $ v2), (\k -> if k == 0.0 then 1.0 else k) . abs .
(\rs -> if null rs then 0.0 else head rs) . firstFrom3 . maximumElBy 1 (VB.singleton oneProperty) $
UL2 (VB.empty,uniquenessVariants2GNB ' ' id id id perms2 (VB.singleton oneProperty) (chooseMin choice) $ v2)))
!zs = if compare l2 0 == LT then concat . take 1 $ flines else VB.toList . lastFrom3 . headU2 . fst . get22 .
uniqNProperties2GN ' ' whspss id id id perms2 (PA VB.empty (VB.fromList . concat . take 1 $ lasts)) 1 1 (VB.singleton (unsafeSwapVecIWithMaxI minE maxE numberI intervalNmbrs . oneProperty)) (chooseMax choice) $ v
toFile (file ++ ".new.txt") (zs:(noDoubleWords . circle2I permsV whspss (concat . take 1 $ lasts) choice [] numberI intervalNmbrs minE maxE . drop 1 $ flines))
else toFileStr (file ++ ".new.txt") ((concat . take 1 $ flines):(noDoubleWords . circle2I permsV whspss (concat . take 1 $ lasts) choice [] numberI intervalNmbrs 0.0 0.0 . drop 1 $ flines))
fLines :: String -> [String]
fLines ys =
let preText = filter (any (\x -> isUkrainianL x && isAlpha x)) . prepareText $ ys
wss = map (length . subG " 01-") preText
g (t:ts) (r:rs) = if r > 7 then filter (`notElem` "01-") t:g ts rs else t:g ts rs
g _ _ = []
in g preText wss
-- | Processment without rearrangements.
circle2 :: VB.Vector (VB.Vector (VB.Vector Int)) -> String -> String -> [String] -> [String] -> [String]
circle2 permsG1 xs choice yss xss
| null xss = yss
| otherwise = circle2 permsG1 (if null rs then [] else last rs) choice (ws:yss) tss
where (!zss,!tss) = splitAt 1 xss
!rs = words . concat $ zss
!ws = if compare (length rs) 3 == LT then unwords (xs:rs) else VB.toList . lastFrom3 . headU2 . fst . get22 .
uniqNProperties2GN ' ' (VB.fromList " 01-") id id id (VB.unsafeIndex permsG1 $ length rs - 3) (PA (VB.fromList xs) (VB.fromList . last $ rs)) 1 1 (VB.singleton oneProperty) (chooseMax choice) . VB.fromList . unwords . init $ rs
-- | Processment with rearrangements.
circle2I :: VB.Vector (VB.Vector (VB.Vector Int)) -> VB.Vector Char -> String -> String -> [String] -> Int -> VB.Vector Int -> Float -> Float -> [String] -> [String]
circle2I permsG1 whspss xs choice yss numberI vI minE maxE xss
| null xss = yss
| otherwise = circle2I permsG1 whspss (if null rs then [] else last rs) choice (ws:yss) numberI vI minE1 maxE1 tss
where (!zss,!tss) = splitAt 1 xss
!w2s = words . concat . take 1 $ tss
!l3 = (subtract 3) . length $ w2s
!rs = words . concat $ zss
!ws = if compare (length rs) 3 == LT then unwords (xs:rs) else VB.toList . lastFrom3 . headU2 . fst . get22 .
uniqNProperties2GN ' ' (VB.fromList " 01-") id id id (VB.unsafeIndex permsG1 $ length rs - 3) (PA (VB.fromList xs) (VB.fromList . last $ rs)) 1 1 (VB.singleton (unsafeSwapVecIWithMaxI minE maxE numberI vI .
oneProperty)) (chooseMax choice) . VB.fromList . unwords . init $ rs
(!maxE1,!minE1)
| compare l3 0 /= LT =
let !perms3 = VB.force . VB.unsafeIndex permsG1 $ l3
!v3 = VB.fromList . unwords . init $ w2s
!v4 = subG whspss v3 in runEval (parTuple2 rpar rpar ((\k -> if k == 0.0 then 1.0 else k) . (\ls -> if null ls then 0.0 else head ls) .
firstFrom3 . maximumElBy 1 (VB.singleton oneProperty) $ UL2 (VB.empty,
uniquenessVariants2GNB ' ' id id id perms3 (VB.singleton oneProperty) (chooseMax choice) $ v4),
(\k -> if k == 0.0 then 1.0 else k) . abs . (\ls -> if null ls then 0.0 else head ls) . firstFrom3 .
maximumElBy 1 (VB.singleton oneProperty) $
UL2 (VB.empty,uniquenessVariants2GNB ' ' id id id perms3 (VB.singleton oneProperty) (chooseMin choice) $ v4)))
| otherwise = (0.0,0.0)
headU2
:: (Foldable t, Foldable t2, InsertLeft t a, Monoid (t a), Monoid (t (t a)), Monoid (t2 b)) => VB.Vector (UniquenessG1T2 t t2 a b)
-> UniquenessG1T2 t t2 a b
headU2 v
| VB.null v = (mempty, VB.empty,mempty)
| otherwise = VB.unsafeIndex v 0
{-# INLINE headU2 #-}
noDoubleWords :: [String] -> [String]
noDoubleWords = map (unwords . drop 1 . words)
{-# INLINE noDoubleWords #-}