{-# OPTIONS_GHC -threaded -rtsopts #-} {-# OPTIONS_HADDOCK show-extensions #-} {-# LANGUAGE BangPatterns #-} -- | -- Module : Phonetic.Languages.Simple -- Copyright : (c) OleksandrZhabenko 2020 -- License : MIT -- Stability : Experimental -- Maintainer : olexandr543@yahoo.com -- -- The library functions for the lineVariantsG3 executable. module Phonetic.Languages.Simple where import Numeric import Languages.UniquenessPeriods.Array.Constraints.Encoded (decodeLConstraints,readMaybeECG) import GHC.Arr import Phonetic.Languages.Simplified.DataG.Base import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2 import Phonetic.Languages.Filters (unsafeSwapVecIWithMaxI) import Phonetic.Languages.Simplified.StrictVG.Base import Phonetic.Languages.Ukrainian.PrepareText import Data.Char (isDigit,isAlpha) import qualified Data.List as L (span,sort,zip4,isPrefixOf,nub) import Phonetic.Languages.Simplified.Array.Ukrainian.FuncRep2RelatedG2 import Phonetic.Languages.Permutations.Arr import Data.SubG hiding (takeWhile,dropWhile) import System.Environment import Data.Maybe import Data.MinMax.Preconditions import Text.Read (readMaybe) import Phonetic.Languages.Simplified.DeEnCoding import Phonetic.Languages.Simplified.SimpleConstraints import Phonetic.Languages.Common forMultiplePropertiesF :: [String] -> [(String,[String])] forMultiplePropertiesF (xs:xss) | any isAlpha xs = (xs,yss):forMultiplePropertiesF zss | otherwise = [] where l = length . takeWhile (all isDigit) $ xss (yss,zss) = splitAt l xss forMultiplePropertiesF _ = [] generalProc2 :: FilePath -> Bool -> Bool -> [String] -> Coeffs2 -> [String] -> Bool -> IO () generalProc2 toFile1 interactive jstL0 args0 coeffs args lstW2 = do let !argMss = take 5 . filter (not . null) . forMultiplePropertiesF . 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 0 . 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 [numberI] else L.nub 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 let !wwss = (:[]) . toResultR frep20 $ xs in if interactive then interactivePrintResult line toFile1 wwss else print1el jstL0 choice wwss 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) if interactive then interactivePrintResult line toFile1 temp else 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) if interactive then interactivePrintResult line toFile1 temp else 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 [numberI] else L.nub 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 0 . 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 let !wwss = (:[]) . toResultR frep20 $ xs in if interactive then interactivePrintResult line toFile1 wwss else print1el jstL0 (concat . take 1 $ choices) wwss else do let !subs = subG " 01-" xs if null argCs then let !perms = genPermutationsL l in generalProcMMs interactive toFile1 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 interactive toFile1 coeffs argsZipped perms subs interactivePrintResult :: (a -> String) -> String -> [a] -> IO () interactivePrintResult f ys xss | null xss = putStrLn "" | otherwise = do let !datas = map (\(idx,str) -> show idx `mappend` ('\t' : str)) . trans232 . map f $ xss mapM_ putStrLn datas putStrLn "" putStrLn "Please, specify the variant which you would like to become the resulting string by its number. " number <- getLine let !lineRes = concat . filter ((number `mappend` "\t")`L.isPrefixOf`) $ datas (\xs -> if null ys then putStrLn xs else putStrLn xs >> appendFile ys (xs `mappend` newLineEnding)) . drop 1 . dropWhile (/= '\t') $ lineRes 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 -> [Array Int Int] -> [String] -> ([Int],Int,Int,String) -> IO [Result [] Char Double Double] 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 (toPropertiesF' frep20) $ variants1 !frep2 = chooseMax (unsafeSwapVecIWithMaxI minE maxE numberI intervalNmbrs) coeffs choice return . fst . maximumGroupsClassificationR arg0 . map (toResultR frep2) $ variants1 generalProcMMs :: Bool -> FilePath -> Coeffs2 -> [([Int],Int,Int,String)] -> [Array Int Int] -> [String] -> IO () generalProcMMs interactiveMM file coeffs rs perms subs = case length rs of 0 -> putStrLn "No data has been specified to control the computation process. " 1 -> putStrLn "You have specified just one variant of the metrices. " >> do temp <- generalProcMs coeffs perms subs (head rs) finalProc interactiveMM file line temp _ -> do genVariants <- mapM (generalProcMs coeffs perms subs) rs finalProc interactiveMM file id . foldlI . map (map line) $ genVariants foldlI :: [[String]] -> [String] foldlI (xs:ys:xss) = foldlI (intersectInterResults xs ys : xss) foldlI (xs:_) = xs foldlI _ = [] finalProc :: Bool -> FilePath -> (a -> String) -> [a] -> IO () finalProc bool ys f xss = if bool then interactivePrintResult f ys xss else mapM_ (putStrLn . f) xss print1el :: Bool -> String -> [Result [] Char Double Double] -> IO () print1el jstlines choice (x:xs) | jstlines == True = putStrLn (line x) >> print1el True choice xs | otherwise = putStrLn (line x) >> putStrLn (showFFloat ch (propertiesF x) "") >> putStrLn (showFFloat ch (transPropertiesF x) "") >> print1el False choice xs where !ch = precChoice choice print1el _ _ _ = return ()