{-# LANGUAGE NoImplicitPrelude, BangPatterns #-} module Phladiprelio.Ukrainian.IO where import GHC.Base import GHC.Num (Integer,(+),(-),(*)) import GHC.Real (fromIntegral,(/),quot,rem,quotRem) import GHC.Enum (fromEnum,toEnum) import Text.Show (Show(..)) import Text.Read (readMaybe) import Data.Char (isDigit) import System.IO (putStrLn, FilePath,stdout,hSetNewlineMode,universalNewlineMode,getLine,appendFile) import Rhythmicity.MarkerSeqs hiding (id) import Data.List hiding (foldr) import Data.Maybe (isNothing,fromJust) import Data.Tuple (fst,snd) import Phladiprelio.Ukrainian.Syllable import Phladiprelio.Ukrainian.SyllableDouble import Phladiprelio.Ukrainian.Melodics import GHC.Int (Int8) import Phladiprelio.Ukrainian.ReadDurations import Data.Ord (comparing) import Numeric (showFFloat) import Phladiprelio.Halfsplit import System.Directory (readable,writable,getPermissions,Permissions(..)) import Data.ReversedScientific import Data.Either import Control.Concurrent.Async (mapConcurrently) generalF :: FilePath -> Int -> HashCorrections -> (Int8,[Int8]) -> Int -> Bool -> Int -> Bool -> Int8 -> (FilePath, Int) -> Bool -- ^ Whether to run tests concurrently or not. 'True' corresponds to concurrent execution that can speed up the getting results but use more resources. -> [String] -> IO [String] generalF file numTest hc (grps,mxms) k descending hashStep emptyline splitting (fs,code) concurrently universalSet@(u1:u2:us) = do syllableDurationsDs <- readSyllableDurations file let syllN = countSyll . concat . take 1 $ universalSet -- universalSet = map unwords . permutations . words $ rs f syllableDurationsDs grps mxms = sum . countHashes2G hashStep hc grps mxms . mconcat . (if null file then case k of { 1 -> syllableDurationsD; 2 -> syllableDurationsD2; 3 -> syllableDurationsD3; 4 -> syllableDurationsD4} else if length syllableDurationsDs >= k then syllableDurationsDs !! (k - 1) else syllableDurationsD2) . createSyllablesUkrS hSetNewlineMode stdout universalNewlineMode if numTest >= 0 && numTest <= 179 && numTest /= 1 then do putStrLn "Feet Val Stat Proxim" (if concurrently then mapConcurrently else mapM) (\(q,qs) -> let m = stat1 syllN (q,qs) (min1, max1) = minMax11ByCList (comparing (f syllableDurationsDs q qs)) universalSet mx = f syllableDurationsDs q qs max1 strTest = (show (fromEnum q) `mappend` " | " `mappend` show mx `mappend` " " `mappend` show m `mappend` " -> " `mappend` showFFloat (Just 3) (100 * fromIntegral mx / fromIntegral m) "%" `mappend` (if rem numTest 10 >= 4 then ("\n" `mappend` min1 `mappend` "\n" `mappend` max1 `mappend` "\n") else "")) in putStrLn strTest >> return strTest) . zip (sel2 numTest) $ (sel numTest) else let sRepresent = zipWith (\k (x, ys) -> S k x ys) [1..] . (let h1 = if descending then (\(u,w) -> ((-1) * u, w)) else id in sortOn h1) . map (\xss -> (f syllableDurationsDs grps mxms xss, xss)) $ universalSet strOutput = (:[]) . halfsplit (\(S _ y _) -> y) (jjj splitting) $ sRepresent in do _ <- mapM putStrLn strOutput let l1 = length sRepresent if code == -1 then return strOutput else parseLineNumber l1 >>= \num -> do permiss <- getPermissions fs let writ = writable permiss readab = readable permiss if writ && readab then appendFile fs (flip outputSel code . head . filter (\(S k _ _) -> k == num) $ sRepresent) else error "The specified file cannot be used for appending the text! Please, specify another file!" return [] where sel x | x == 1 || x < 0 || x > 179 = [] | x == 0 || x == 4 = [[1],[2,1],[3,2],[4,3,2],[5,4,3],[6,5,4,3,2]] -- all cases are present: 2, 3, 4, 5, 6, 7. Therefore, the slowest ones. | x == 2 || x == 5 = [[1],[2],[3],[4,3],[5,4],[6,5,4]] | x == 7 = [[0],[1,0],[1,0],[1,0],[1,0],[1,0]] | x == 8 = [[0],[1,0],[1,0],[2,1,0],[2,1,0],[2,1,0]] | x == 9 = [[0],[1,0],[1,0],[2,1,0],[3,2,1,0],[3,2,1,0]] ----------------------------------------------------------------------------- | x >= 20 && x <= 26 && x /= 21 = [[1]] -- at least 7 is omitted, but probably 6, or even 5, or even 4, or even 3. 2 is however present. | x >= 27 && x <= 29 = [[0]] | x == 30 || x == 34 = [[1],[2,1]] | x == 32 || x == 35 = [[1],[2]] | x >= 37 && x <= 39 = [[0],[1,0]] | x == 40 || x == 44 = [[1],[2,1],[3,2]] | x == 42 || x == 45 = [[1],[2],[3]] | x >= 47 && x <= 49 = [[0],[1,0],[1,0]] | x == 50 || x == 54 = [[1],[2,1],[3,2],[4,3,2]] | x == 52 || x == 55 = [[1],[2],[3],[4,3]] | x == 57 = [[0],[1,0],[1,0],[1,0]] | x == 58 || x == 59 = [[0],[1,0],[1,0],[2,1,0]] | x == 60 || x == 64 = [[1],[2,1],[3,2],[4,3,2],[5,4,3]] | x == 62 || x == 65 = [[1],[2],[3],[4,3],[5,4]] | x == 67 = [[0],[1,0],[1,0],[1,0],[1,0]] | x == 68 = [[0],[1,0],[1,0],[2,1,0],[2,1,0]] | x == 69 = [[0],[1,0],[1,0],[2,1,0],[3,2,1,0]] ----------------------------------------------------------------- | x == 70 || x == 74 = [[2,1],[3,2],[4,3,2],[5,4,3],[6,5,4,3,2]] -- at least 2 is omitted, but probably 3 and even 4. 5, 6 and 7 are present. | x == 72 || x == 75 = [[2],[3],[4,3],[5,4],[6,5,4]] | x == 77 = [[1,0],[1,0],[1,0],[1,0],[1,0]] | x == 78 = [[1,0],[1,0],[2,1,0],[2,1,0],[2,1,0]] | x == 79 = [[1,0],[1,0],[2,1,0],[3,2,1,0],[3,2,1,0]] | x == 80 || x == 84 = [[3,2],[4,3,2],[5,4,3],[6,5,4,3,2]] | x == 82 || x == 85 = [[3],[4,3],[5,4],[6,5,4]] | x == 87 = [[1,0],[1,0],[1,0],[1,0]] | x == 88 = [[1,0],[2,1,0],[2,1,0],[2,1,0]] | x == 89 = [[1,0],[2,1,0],[3,2,1,0],[3,2,1,0]] | x == 90 || x == 94 = [[4,3,2],[5,4,3],[6,5,4,3,2]] | x == 92 || x == 95 = [[4,3],[5,4],[6,5,4]] | x == 97 = [[1,0],[1,0],[1,0]] | x == 98 = [[2,1,0],[2,1,0],[2,1,0]] | x == 99 = [[2,1,0],[3,2,1,0],[3,2,1,0]] ----------------------------------------------------------------------------------- | x == 100 || x == 104 = [[1],[2,1],[4,3,2],[6,5,4,3,2]] -- 4 and 6 are omitted, just present the ones from: 2, 3, 5, 7. | x == 102 || x == 105 = [[1],[2],[4,3],[6,5,4]] | x == 107 = [[0],[1,0],[1,0],[1,0]] | x == 108 = [[0],[1,0],[2,1,0],[2,1,0]] | x == 109 = [[0],[1,0],[2,1,0],[3,2,1,0]] ----------------------------------------------------------------------------- | x == 150 || x == 154 = [[1],[2,1],[4,3,2]] -- 4, 6, 7 are omitted but 2, 3, 5 are present. | x == 152 || x == 155 = [[1],[2],[4,3]] | x == 157 = [[0],[1,0],[1,0]] | x == 158 || x == 159 = [[0],[1,0],[2,1,0]] ----------------------------------------------------------------- | x == 170 || x == 174 = [[2,1],[4,3,2],[6,5,4,3,2]] -- just 3, 5 and 7 are present | x == 172 || x == 175 = [[2],[4,3],[6,5,4]] | x == 177 = [[1,0],[1,0],[1,0]] | x == 178 = [[1,0],[2,1,0],[2,1,0]] | x == 179 = [[1,0],[2,1,0],[3,2,1,0]] ---------------------------------------------------------------------------------- | otherwise = [[1],[1],[2,1],[3,2,1],[3,2],[4,3,2]] -------------------------------------------------------------------------------------------- -------------------------------------------------------------------------------------------- sel2 y | y == 1 || y < 0 || y > 179 = [] | (rem y 10 `elem` [1,3,6]) || y >= 0 && y <= 9 = [2..7] | y >= 20 && y <= 69 = [2..toEnum (y `quot` 10)] | y >= 70 && y <= 99 = [toEnum (y `quot` 10) - 4..7] | y >= 100 && y <= 109 = [2,3,5,7] | y >= 150 && y <= 159 = [2,3,5] | y >= 170 && y <= 179 = [3,5,7] | otherwise = [2..7] minMax11ByCList :: Ord a => (a -> a -> Ordering) -> [a] -> (a, a) -- Is rewritten from the 'Data.MinMax.Preconditions.minMax11ByC' from @subG@ package. minMax11ByCList g xs@(x:y:ys) = foldr f (if x > y then (y, x) else (x, y)) ys where f z (x,y) | g z x == LT = (z,y) | g z y == GT = (x,z) | otherwise = (x,y) minMax11ByCList _ _ = undefined -- Is not intended to be used for lists with less than two elements. jjj kk = let (q1,r1) = quotRem kk (if kk < 0 then -10 else 10) in jjj' q1 r1 emptyline jjj' q1 r1 emptyline | r1 == (-1) || r1 == (-3) = -10*q1 + (if emptyline then -5 else r1) | r1 == 1 || r1 == 3 = 10*q1 + (if emptyline then 5 else r1) | r1 < 0 = -10*q1 + (if emptyline then -4 else r1) | otherwise = 10*q1 + (if emptyline then 4 else r1) generalF _ _ _ _ _ _ _ _ _ _ _ [u1] = mapM putStrLn [u1] >> return [u1] generalF _ _ _ _ _ _ _ _ _ _ _ _ = let strOutput = ["You have specified the data and constraints on it that lead to no further possible options.", "Please, specify another data and constraints."] in mapM putStrLn strOutput >> return strOutput data PhladiprelioUkr = S Int Integer String deriving Eq instance Show PhladiprelioUkr where show (S i j xs) = showBignum 7 j `mappend` " " `mappend` xs `mappend` " " `mappend` showWithSpaces 4 i countSyll :: String -> Int countSyll xs = fromEnum . foldr (\x y -> if isVowel1 x then y + 1 else y) 0 . convertToProperUkrainianI8 $ xs stat1 :: Int -> (Int8,[Int8]) -> Int stat1 n (k, ks) = fst (n `quotRemInt` fromEnum k) * length ks parseHelp :: [String] -> (String,[String]) parseHelp xss | null xss = ([],[]) | otherwise = (unwords rss, uss `mappend` qss) where (yss,tss) = break (== "-b") xss (uss,wss) = break (== "+b") yss [qss,rss] = map (drop 1) [tss, wss] outputSel :: PhladiprelioUkr -> Int -> String outputSel (S x1 y1 ts) code | code < 0 = [] | code == 0 = ts `mappend` "\n" | code == 1 = intercalate " " [show x1, ts] `mappend` "\n" | code == 2 = intercalate " " [show y1, ts] `mappend` "\n" | code == 3 = intercalate " " [show x1, ts, show y1] `mappend` "\n" | code == 4 = intercalate " " [show x1, show y1] `mappend` "\n" | otherwise = ts `mappend` "\n" parseLineNumber :: Int -> IO Int parseLineNumber l1 = do putStrLn "Please, specify the number of the option to be written to the file specified: " number <- getLine let num = readMaybe (filter isDigit number)::Maybe Int if isNothing num || num > Just l1 || num == Just 0 then parseLineNumber l1 else return . fromJust $ num