-- |
-- Module : Main
-- Copyright : (c) OleksandrZhabenko 2020
-- License : MIT
-- Stability : Experimental
-- Maintainer : olexandr543@yahoo.com
--
-- Prints the rearrangements with the \"property\" information for the Ukrainian language text.
-- The most interesting is the first line of the output. But other ones also are noteworthy.
{-# OPTIONS_GHC -threaded -rtsopts #-}
{-# LANGUAGE BangPatterns #-}
module Main where
import Numeric
import Languages.UniquenessPeriods.Vector.Constraints.Encoded (decodeLConstraints,readMaybeECG)
import qualified Data.Vector as VB
import Phonetic.Languages.Simplified.DataG
import Phonetic.Languages.Lists.Ukrainian.PropertiesSyllablesG
import Languages.UniquenessPeriods.Vector.Filters (unsafeSwapVecIWithMaxI)
import Phonetic.Languages.Simplified.StrictVG
import Languages.Phonetic.Ukrainian.PrepareText
import Data.Char (isDigit,isAlpha)
import Melodics.ByteString.Ukrainian (isUkrainianL)
import qualified Data.List as L (span,sort,zip4,uncons)
import Phonetic.Languages.Simplified.Lists.Ukrainian.FuncRep2RelatedG
import Phonetic.Languages.Permutations
import Data.SubG hiding (takeWhile,dropWhile)
import System.Environment
import Data.Maybe
import Data.MinMax.Preconditions
import Text.Read (readMaybe)
import Phonetic.Languages.Simplified.Lists.DeEnCoding
-- | Prints the rearrangements with the \"property\" information for the Ukrainian language text. The first command line argument must be a
-- positive 'Int' number and is a number of printed variants for the line (if they are present, otherwise just all possible variants are printed).
-- The second one is the number of the intervals into which the all range of possible metrics values are divided. The next numeric arguments that must be
-- sequenced without interruptions further are treated as the numbers of the intervals (counting is started from 1) which values are moved to the maximum
-- values of the metrics interval using the 'unsafeSwapVecIWithMaxI' function. The first textual command line argument should be in the form either \"y0\",
-- or \"0y\", or \"yy\", or \"y\", or \"02y\", or \"y2\", or some other variant and specifies, which property or properties is or are evaluated.
-- The rest of the command line arguments is the Ukrainian text. Besides, you can use multiple metrices (no more than 3 different ones) together by
-- using \"+M\" ... \"-M\" command line arguments.
--
-- You can specify constraints according to the 'decodeLConstraints' function between +A and -A command line arguments. If so, the program will
-- ask you additional question before proceeding. The \"+M\" ... \"-M\" and \"+A\" ... \"-A\" groups must not mutually intersect one another.
main :: IO ()
main = do
args00 <- getArgs
let args0 = filter (\xs -> xs /= "++B" && xs /= "++L" && xs /= "++BL") args00
lstW = if any (\x -> x == "++B" || x == "++BL") args00 then True else False -- If one of the command line options is \"++B\" or \"++BL\" then the last word of the line will remain the last one.
jstL0 = if any (\x -> x == "++L" || x == "++BL") args00 then True else False -- If one of the command line options is \"++L\" or \"++BL\" then the program outputs just lines without metrices values.
args01 = takeWhile (/= "+A") args0 `mappend` (drop 1 . dropWhile (/= "-A") $ args0)
args = takeWhile (/= "+M") args01 `mappend` (drop 1 . dropWhile (/= "-M") $ args01)
coeffs = readCF . concat . take 1 $ args -- The first command line argument. If not sure, just pass \"1_\".
if isPair coeffs then generalProc2 jstL0 args0 coeffs (drop 1 args) lstW
else generalProc2 jstL0 args0 coeffs args lstW
showB :: Int -> Bool -> String
showB n bool
| n >= 2 && bool == True = 'B':show (n - 1) `mappend` concatMap show [0..n - 2]
| otherwise = ""
forMultipleMetrices :: [String] -> [(String,[String])]
forMultipleMetrices (xs:xss)
| any isAlpha xs = (xs,yss):forMultipleMetrices zss
| otherwise = []
where l = length . takeWhile (all isDigit) $ xss
(yss,zss) = splitAt l xss
forMultipleMetrices _ = []
generalProc2 :: Bool -> [String] -> Coeffs2 -> [String] -> Bool -> IO ()
generalProc2 jstL0 args0 coeffs args lstW2 = do
let !argMss = take 3 . filter (not . null) . forMultipleMetrices . drop 1 . dropWhile (/= "+M") . takeWhile (/= "-M") $ args0
if null argMss then do
let (!numericArgs,!textualArgs) = L.span (all isDigit) $ args
!xs = concat . take 1 . fLines . unwords . drop 1 $ textualArgs
!l = length . words $ xs
!argCs = catMaybes (fmap (readMaybeECG (l - 1)) . (showB l lstW2:) . drop 1 . dropWhile (/= "+A") . takeWhile (/= "-A") $ args0)
!arg0 = fromMaybe 1 $ (readMaybe (concat . take 1 $ numericArgs)::Maybe Int)
!numberI = fromMaybe 1 $ (readMaybe (concat . drop 1 . take 2 $ numericArgs)::Maybe Int)
!choice = concat . take 1 $ textualArgs
!intervalNmbrs = (\zs -> if null zs then VB.singleton numberI else VB.uniq . VB.fromList $ zs) . L.sort . filter (<= numberI) .
map (\t -> fromMaybe numberI $ (readMaybe t::Maybe Int)) . drop 2 $ numericArgs
if compare l 2 == LT then let !frep20 = chooseMax id coeffs choice in print1el jstL0 choice . (:[]) . toResultR frep20 $ xs
else do
let !subs = subG " 01-" xs
if null argCs then let !perms = genPermutationsL l in do
temp <- generalProcMs coeffs perms subs (intervalNmbrs, arg0, numberI, choice)
print1el jstL0 choice temp
else do
correct <- printWarning xs
if correct == "n" then putStrLn "You stopped the program, please, if needed, run it again with better arguments. "
else let !perms = decodeLConstraints argCs . genPermutationsL $ l in do
temp <- generalProcMs coeffs perms subs (intervalNmbrs, arg0, numberI, choice)
print1el jstL0 choice temp
else do
let !choices = map fst argMss
!numericArgss = map snd argMss
!arg0s = map (\ts -> fromMaybe 1 $ (readMaybe (concat . take 1 $ ts)::Maybe Int)) numericArgss
!numberIs = map (\ts -> fromMaybe 1 $ (readMaybe (concat . drop 1 . take 2 $ ts)::Maybe Int)) numericArgss
!intervalNmbrss = map (\us -> let !numberI = fromMaybe 1 $ (readMaybe (concat . drop 1 . take 2 $ us)::Maybe Int) in
(\zs -> if null zs then VB.singleton numberI else VB.uniq . VB.fromList $ zs) . L.sort . filter (<= numberI) .
map (\t -> fromMaybe numberI $ (readMaybe t::Maybe Int)) . drop 2 $ us) $ numericArgss
!argsZipped = L.zip4 intervalNmbrss arg0s numberIs choices
!xs = concat . take 1 . fLines . unwords $ args
!l = length . words $ xs
!argCs = catMaybes (fmap (readMaybeECG (l - 1)) . (showB l lstW2:) . drop 1 . dropWhile (/= "+A") . takeWhile (/= "-A") $ args0)
if compare l 2 == LT then let !frep20 = chooseMax id coeffs (concat . take 1 $ choices) in print1el jstL0 (concat . take 1 $ choices) . (:[]) . toResultR frep20 $ xs
else do
let !subs = subG " 01-" xs
if null argCs then let !perms = genPermutationsL l in generalProcMMs coeffs argsZipped perms subs
else do
correct <- printWarning xs
if correct == "n" then putStrLn "You stopped the program, please, if needed, run it again with better arguments. "
else let !perms = decodeLConstraints argCs . genPermutationsL $ l in generalProcMMs coeffs argsZipped perms subs
printWarning :: String -> IO String
printWarning xs = do
putStr "Please, check whether the line below corresponds and is consistent with the constraints you have specified between the +A and -A options. "
putStr "Check also whether you have specified the \"++B\" or \"++BL\" option(s). "
putStrLn "If it is inconsistent then enter further \"n\", press Enter and then run the program again with better arguments. "
putStrLn "If the line is consistent with your input between +A and -A then just press Enter to proceed further. "
putStrLn xs
getLine
generalProcMs :: Coeffs2 -> [VB.Vector Int] -> [String] -> (VB.Vector Int,Int,Int,String) -> IO [Result [] Char Float Float]
generalProcMs coeffs perms subs (intervalNmbrs, arg0, numberI, choice) = do
if compare numberI 2 == LT then let !frep2 = chooseMax id coeffs choice in return . fst . maximumGroupsClassificationR arg0 .
map (toResultR frep2) . uniquenessVariants2GNBL ' ' id id id perms $ subs
else do
let !variants1 = uniquenessVariants2GNBL ' ' id id id perms subs
!frep20 = chooseMax id coeffs choice
(!minE,!maxE) = minMax11C . map (toMetrices' frep20) $ variants1
!frep2 = chooseMax (unsafeSwapVecIWithMaxI minE maxE numberI intervalNmbrs) coeffs choice
return . fst . maximumGroupsClassificationR arg0 . map (toResultR frep2) $ variants1
generalProcMMs :: Coeffs2 -> [(VB.Vector Int,Int,Int,String)] -> [VB.Vector Int] -> [String] -> IO ()
generalProcMMs coeffs rs perms subs = do
genVariants <- mapM (generalProcMs coeffs perms subs) rs
let !lineVs = map (map line) genVariants
!l3 = length lineVs
case l3 of
3 -> mapM_ putStrLn l123
where Just (!l1,!ls) = L.uncons lineVs
[!l12,!l13] = map (intersectInterResults l1) ls
!l123 = intersectInterResults l12 l13
2 -> mapM_ putStrLn . intersectInterResults l1 $ l3
where [!l1,!l3] = lineVs
_ -> putStrLn "You have specified just one variant of the metrices. " >> do
temp <- generalProcMs coeffs perms subs (head rs)
mapM_ (putStrLn . line) temp
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
print1el :: Bool -> String -> [Result [] Char Float Float] -> IO ()
print1el jstlines choice (x:xs)
| jstlines == True = putStrLn (line x) >> print1el True choice xs
| otherwise = putStrLn (line x) >> putStrLn (showFFloat ch (metrices x) "") >>
putStrLn (showFFloat ch (transMetrices x) "") >> print1el False choice xs
where !ch = precChoice choice
print1el _ _ _ = return ()