{-# LANGUAGE NoImplicitPrelude, BangPatterns #-} module Main 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 Rhythmicity.BasicF import Data.List hiding (foldr) import Data.Maybe (fromMaybe,catMaybes,isNothing,fromJust) import Data.Tuple (fst,snd) import Phladiprelio.Ukrainian.PrepareText import Phladiprelio.Ukrainian.Syllable import Phladiprelio.Ukrainian.SyllableDouble import Phladiprelio.Ukrainian.Melodics import System.Environment (getArgs) import GHC.Int (Int8) import CLI.Arguments import CLI.Arguments.Get import CLI.Arguments.Parsing import Phladiprelio.Ukrainian.ReadDurations import Data.Ord (comparing) import Phladiprelio.PermutationsRepresent import Phladiprelio.ConstraintsEncoded import Phladiprelio.PermutationsArr import Phladiprelio.StrictVG import Numeric (showFFloat) import Phladiprelio.Halfsplit import System.Directory (doesFileExist,readable,writable,getPermissions,Permissions(..)) generalF :: FilePath -> Int -> HashCorrections -> (Int8,[Int8]) -> Int -> Bool -> Int -> Bool -> Int8 -> (FilePath, Int) -> [String] -> IO [String] generalF file numTest hc (grps,mxms) k descending hashStep emptyline splitting (fs,code) 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" 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) = show j `mappend` " " `mappend` xs `mappend` " " `mappend` show 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 main :: IO () main = do args0 <- getArgs let (argCBs, args) = parseHelp args0 (argsA, argsB, argsC, arg2s) = args2Args31R ('+','-') (aSpecs `mappend` bSpecs `mappend` cSpecs) args fileDu = concat . getB "+d" $ argsB sylD = let k = snd (fromMaybe 2 (readMaybe (concat . getB "+s" $ argsB)::Maybe Int) `quotRemInt` 4) in if k == 0 then 4 else k hc = readHashCorrections . concat . getB "+c" $ argsB prepare = oneA "-p" argsA grpp = grouppingR . concat . getB "+r" $ argsB splitting = fromMaybe 50 (readMaybe (concat . getB "+w" $ argsB)::Maybe Int8) emptyline = oneA "+l" argsA numTest = fromMaybe 1 (readMaybe (concat . getB "-t" $ argsB)::Maybe Int) hashStep = fromMaybe 20 (readMaybe (concat . getB "+k" $ argsB)::Maybe Int) helpMessage = oneA "-h" argsA argCs = catMaybes (fmap (readMaybeECG l) -- . (showB l lstW2:) . getC "+a" $ argsC) filedata = getB "+f" argsB (filesave,codesave) | null filedata = ("",-1) | length filedata == 2 = (head filedata, fromMaybe 0 (readMaybe (last filedata)::Maybe Int)) | otherwise = (head filedata,0) ll = take 7 . (if prepare then id else words . mconcat . prepareText . unwords) $ arg2s l = length ll !perms | not (null argCBs) = filterGeneralConv l argCBs . genPermutationsL $ l | null argCs = genPermutationsL l | otherwise = decodeLConstraints argCs . genPermutationsL $ l descending = oneA "+n" argsA variants1 = uniquenessVariants2GNBL ' ' id id id perms ll if helpMessage then do putStrLn "SYNOPSIS:" putStrLn "" putStrLn "phladiprelioUkr [+a -a] [+b -b] [+c ] [+n] [+l] [+d ] [+k ] [+r ] [-t ] [+s ] [-p] [+w ] [+f ] " putStrLn "" putStrLn "+n \t— if specified then the order of sorting and printing is descending (the reverse one to the default otherwise). " putStrLn "" putStrLn "+l \t— if specified then the output for one property (no tests) contains empty lines between the groups of the line option with the same value of property. " putStrLn "" putStrLn "+w \t— if specified with the next Int8 number then the splitting of the output for non-testing options is used. Is used when no \"-t\" argument is given. The output is splitten into two columns to improve overall experience. The parameter after the \"+w\" is divided by 10 (-10 for negative numbers) to obtain the quotient and remainder (Int8 numbers). The quotient specifies the number of spaces or tabular characters to be used between columns (if the parameter is positive then the spaces are used, otherwise tabular characters). The remainder specifies the option of displaying. If the absolute value of the remainder (the last digit of the parameter) is 1 then the output in the second column is reversed; if it is in the range [2..5] then the output is groupped by the estimation values: if it is 2 then the first column is reversed; if it is 3 then the second column is reversed; if it is 4 then like 2 but additionally the empty line is added between the groups; if it is 5 then like for 3 and additionally the empty line is added between the groups. Otherwise, the second column is reversed. The rules are rather complex, but you can give a try to any number (Int8, [129..128] in the fullscreen terminal). The default value is 50 that corresponds to some reasonable layout." putStrLn "" putStrLn "+s \t— the next is the digit from 1 to 4 included. The default one is 2. Influences the result in the case of +d parameter is not given. " putStrLn "" putStrLn "+d \t— see: https://web.archive.org/web/20220610171812/https://raw.githubusercontent.com/OleksandrZhabenko/phonetic-languages-data/main/0.20.0.0/56.csv as a format for the file." putStrLn "" putStrLn "-p \t— if present the minimal grammar transformations (appending and prepending the dependent parts) are not applied. Can be useful also if the text is analyzed as a Ukrainian transcription of text in some other language." putStrLn "" putStrLn "+f \t— if present with two arguments specifies the file to which the output infomation should be appended and the mode of appending (which parts to write). The default value if the secodnd parameter is 0 or not element of [1..4] is just the resulting String option. If the second parameter is 1 then the sequential number and the text are written; if it is 2 then the estimation value and the string are written; if it is 3 then the full information is written i. e. number, string and estimation; if it is 4 then the number and estimation (no string). " putStrLn "" putStrLn "+a ... -a \t— if present contains a group of constraints for PhLADiPreLiO. For more information, see: " putStrLn "https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#constraints in English or in Ukrainian: " putStrLn "https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Ukr.21.html#%D0%BE%D0%B1%D0%BC%D0%B5%D0%B6%D0%B5%D0%BD%D0%BD%D1%8F-constraints" putStrLn "" putStrLn "+b ... -b \t— if present takes precedence over those ones in the +a ... -a group (the latter ones have no effect). A group of constraints for PhLADiPreLiO using some boolean-based algebra. If you use parentheses there, please, use quotation of the whole expression between the +b and -b (otherwise there will be issues with the shell or command line interpreter lelated to parentheses). For example, on Linux bash or Windows PowerShell: +b \'P45(A345 B32)\' -b. If you use another command line environment or interpreter, please, refer to the documentation for your case about the quotation and quotes. For more information, see:" putStrLn "https://oleksandr-zhabenko.github.io/uk/rhythmicity/phladiprelioEng.5.2.pdf in English or: " putStrLn "https://oleksandr-zhabenko.github.io/uk/rhythmicity/phladiprelioUkr.5.2.pdf in Ukrainian." putStrLn "" putStrLn "+r \t— afterwards are several unique digits not greater than 8 in the descending order — the first one is the length of the group of syllables to be considered as a period, the rest — positions of the maximums and minimums. Example: \"543\" means that the line is splitted into groups of 5 syllables starting from the beginning, then the positions of the most maximum (4 = 5 - 1) and the next (smaller) maximum (3 = 4 - 1). If there are no duplicated values then the lowest possible value here is 0, that corresponds to the lowest minimum. If there are duplicates then the lowest value here is the number of the groups of duplicates, e. g. in the sequence 1,6,3,3,4,4,5 that is one group there are two groups of duplicates — with 3 and 4 — and, therefore, the corresponding data after +r should be 7...2. The values less than the lowest minimum are neglected." putStrLn "" putStrLn "+c \t— see explanation at the link: https://hackage.haskell.org/package/rhythmic-sequences-0.3.0.0/docs/src/Rhythmicity.MarkerSeqs.html#HashCorrections" putStrLn "" putStrLn "-t \t— and afterwards the number in the range [0..179] (with some exceptions) showing the test for \'smoothness\' (to be more accurate - absense or presense of some irregularities that influences the prosody) to be run - you can see a list of possible values for the parameter here at the link: " putStrLn "https://hackage.haskell.org/package/phladiprelio-ukrainian-simple-0.6.0.0/src/app/Main.hs on the lines number: 51; 56-115; 118-126. The first section of the lines numbers 56-63 and 120 corresponds to the detailed explanation below. " putStrLn "For different data and probably for different languages being represented here as a corresponding Ukrainian transliteration created by the user himself / herself some preliminary trials show that the following values have tendencies to manifest the following ideas and statements. If the argument here is 0 - test for \'smoothness\' is more extended, if 2 - less extended, more permissive, if 3 - the test for some values expected to be not the maximum nor the minimum ones in the line with no repetitions (the most common case), this option for its greatest values tends to give either more \'irregular\' lines (more jumping-like or wavy combinations) than other ones or more \'regular\' ones - it depends on the distribution of not included into account maximums and minimums; the lines with the minimum values here can be of different kinds but they are not \'stable\'; if 4 - similar to 0, but additionally there are printed two options for every part of test - one that corresponds to minimum value and one that corresponds the maximum value; if 5 - similar to 2, but additionally there are printed two options for every part of test - one that corresponds to minimum value and one that corresponds the maximum value; if 6 - similar to 3, but additionally there are printed two options for every part of test - one that corresponds to minimum value and one that corresponds the maximum value; if 7, 8, or 9 — then there are printed the mixmimum and maximum example strings for the minimums positions in the lines without repetitions during the period (feet), with more minimums taken into account with greater digit here, for 7 it is just 1 or 2 minimuums; otherwise - no tests at all (if no digit is here then it is likely that the first word can be used instead and it will be removed from the input)." putStrLn "If you use here the values from the range of 20-99 then it corresponds to the reduced set of values with all the intermediate elements included: e. g. 2, 3, 4 and 5." putStrLn "If you use here the values from the range of 100-179 then there are only primary numbers used for the number of syllables in the groups - just 2, 3, 5, or 7 or some subset of this set. This lead to some fastening the computation and can be beneficial to overall performance and presenting. Nevertheless, some important or valuable results can be omitted due to omittion of the composed numbers (4 and 6). Use with this caution." putStrLn "" putStrLn "+k \t— and then the number greater than 2 (better, greater than 12, the default value if not specified is 20). The greater value leads to greater numbers. The number less than some infimum here leads to wiping of some information from the result and, therefore, probably is not the desired behaviour. For most cases the default value is just enough sensible, but you can give it a try for other values." putStrLn "" else generalF fileDu numTest hc grpp sylD descending hashStep emptyline splitting (filesave, codesave) variants1 >> return () bSpecs :: CLSpecifications bSpecs = (zip ["+c","+d","+k","+r","+s","-t","+w"] . cycle $ [1]) `mappend` [("+f",2)] aSpecs :: CLSpecifications aSpecs = zip ["-h", "+l", "+n","-p"] . cycle $ [0] cSpecs :: CLSpecifications cSpecs = [("+a",-1)]