phonetic-languages-simplified-lists-examples 0.2.0.0 → 0.3.0.0

raw patch · 6 files changed

+85/−41 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• Lines/Main.hs +1/−7
• Phonetic/Languages/Simplified/Lists/DeEnCoding.hs +14/−0
• README.md +2/−1
• Simple/Main.hs +60/−32
• phonetic-languages-simplified-lists-examples.cabal +1/−1

@@ -16,3 +16,10 @@  ** Added the possibility to use multiple metrices at once by using +M ... -M blocks of command line arguments. The type of metrics is the first argument and the numeric arguments for it (as usual) are all further, then again you can specify up to two additional metrices with arguments enclosed by the block +M and -M delimiters.++## 0.3.0.0 -- 2020-12-03++* Third version. Extended the multiple properties mode up to 4 different properties. Added the possibility to use more+intercation by interactive mode and to write the single line result to file in file writing mode.+Some documentation improvements.+

@@ -14,6 +14,7 @@  module Main where +import Phonetic.Languages.Simplified.Lists.DeEnCoding (newLineEnding) import System.IO import Data.SubG import Data.MinMax.Preconditions@@ -126,10 +127,3 @@   -> [String] -- ^ Each element is appended on the new line to the file.   -> IO () toFileStr file xss = mapM_ (\xs -> appendFile file (xs `mappend` newLineEnding)) xss---- | Auxiliary printing function to define the line ending in some cases. Is taken from the--- Languages.UniquenessPeriods.Vector.General.DebugG module from the @phonetic-languages-general@ package-newLineEnding :: String-newLineEnding-  | nativeNewline == LF = "\n"-  | otherwise = "\r\n"

@@ -16,6 +16,7 @@ import GHC.Int import Data.Foldable (foldl') import Data.List (sortBy,sort)+import System.IO  --default (Int, Double) @@ -35,6 +36,12 @@ trans2 = init . indexedL [] {-# INLINE trans2 #-} +trans232 :: [[a]] -> [(Int, [a])]+trans232 zs = init . foldr f v $ zs+  where !v = [(length zs + 1,[])]+        f x ((j,z):ys) = (j-1,x):(j,z):ys+{-# INLINE trans232 #-}+ int2l :: Int -> [Int8] int2l n  | n < 10 = [toEnum n]@@ -69,3 +76,10 @@  | null zss = const []  | otherwise = fromHeap (head zss) . Heap.intersect (toHeap zss) . toHeap {-# INLINE intersectInterResults #-}++-- | Auxiliary printing function to define the line ending in some cases. Is taken from the+-- Languages.UniquenessPeriods.Vector.General.DebugG module from the @phonetic-languages-general@ package+newLineEnding :: String+newLineEnding+  | nativeNewline == LF = "\n"+  | otherwise = "\r\n"

@@ -1,4 +1,5 @@ The short (possibly) instruction how to use the programs of the package phonetic-languages-simplified-lists-examples in Ukrainian is here: -https://oleksandrzhabenko.github.io/uk/%D0%9A%D0%BE%D1%80%D0%BE%D1%82%D0%BA%D0%B0_%D1%96%D0%BD%D1%81%D1%82%D1%80%D1%83%D0%BA%D1%86%D1%96%D1%8F_%D1%89%D0%BE%D0%B4%D0%BE_%D0%BA%D0%BE%D1%80%D0%B8%D1%81%D1%82%D1%83%D0%B2%D0%B0%D0%BD%D0%BD%D1%8F_%D0%BF%D1%80%D0%BE%D0%B3%D1%80%D0%B0%D0%BC%D0%B0%D0%BC%D0%B8_%D0%BF%D0%B0%D0%BA%D0%B5%D1%82%D1%83_phonetic-languages-simplified-lists-examples-0.2.0.0.pdf+https://web.archive.org/web/20201203115451/https://oleksandrzhabenko.github.io/uk/%D0%9A%D0%BE%D1%80%D0%BE%D1%82%D0%BA%D0%B0_%D1%96%D0%BD%D1%81%D1%82%D1%80%D1%83%D0%BA%D1%86%D1%96%D1%8F_%D1%89%D0%BE%D0%B4%D0%BE_%D0%BA%D0%BE%D1%80%D0%B8%D1%81%D1%82%D1%83%D0%B2%D0%B0%D0%BD%D0%BD%D1%8F_%D0%BF%D1%80%D0%BE%D0%B3%D1%80%D0%B0%D0%BC%D0%B0%D0%BC%D0%B8_%D0%BF%D0%B0%D0%BA%D0%B5%D1%82%D1%83_phonetic-languages-simplified-lists-examples-0.3.0.0.pdf+

@@ -24,7 +24,7 @@ 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 qualified Data.List  as L (span,sort,zip4,isPrefixOf) import Phonetic.Languages.Simplified.Lists.Ukrainian.FuncRep2RelatedG import Phonetic.Languages.Permutations import Data.SubG hiding (takeWhile,dropWhile)@@ -41,7 +41,7 @@ -- 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+-- The rest of the command line arguments is the Ukrainian text. Besides, you can use multiple metrices (no more than 4 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@@ -49,14 +49,19 @@ main :: IO () main = do  args00 <- getArgs- let args0 = filter (\xs -> xs /= "++B" && xs /= "++L" && xs /= "++BL") args00+ let args0 = filter (\xs -> xs /= "++B" && xs /= "++L" && xs /= "++BL" && xs /= "++I") 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.+     toFileMode1 = concat . take 1 . drop 1 . dropWhile (/= "+IF") . takeWhile (/= "-IF") $ args0  -- Prints the last resulting line of the interactive mode processment (the last selected variant) to the file and also to the stdout.+     interactiveP = if any (\xs -> xs == "++I" || xs == "+IF") args00 then True else False -- If one of the command line options is \"++I\", or \"+FIB\", or \"+IF\" then the program prints the variants and then prompts for the preferred variant. Afterwards, it prints just that variant alone.      args01 = takeWhile (/= "+A") args0 `mappend` (drop 1 . dropWhile (/= "-A") $ args0)-     args = takeWhile (/= "+M") args01 `mappend` (drop 1 . dropWhile (/= "-M") $ args01)+     args02+      | null toFileMode1 = filter (\xs -> xs /= "+IF" && xs /= "-IF") args01+      | otherwise = takeWhile (/= "+IF") args01 `mappend` (drop 1 . dropWhile (/= "-IF") $ args01)+     args = takeWhile (/= "+M") args02 `mappend` (drop 1 . dropWhile (/= "-M") $ args02)      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+ if isPair coeffs then generalProc2 toFileMode1 interactiveP jstL0 args0 coeffs (drop 1 args) lstW+ else generalProc2 toFileMode1 interactiveP jstL0 args0 coeffs args lstW  showB :: Int -> Bool -> String showB n bool@@ -71,9 +76,9 @@            (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+generalProc2 :: FilePath -> Bool -> Bool -> [String] -> Coeffs2 -> [String] -> Bool -> IO ()+generalProc2 toFile1 interactive jstL0 args0 coeffs args lstW2 = do+  let !argMss = take 4 . 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@@ -84,18 +89,19 @@        !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+   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)-          print1el jstL0 choice temp+          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)-          print1el jstL0 choice temp+          if interactive then interactivePrintResult line toFile1 temp else print1el jstL0 choice temp   else do    let !choices = map fst argMss        !numericArgss = map snd argMss@@ -108,15 +114,27 @@        !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+   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 coeffs argsZipped perms subs+    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 coeffs argsZipped perms subs+     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. "+     numb <- getLine+     let !lineRes = concat . filter ((numb `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. "@@ -137,22 +155,33 @@         !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+generalProcMMs :: Bool -> FilePath -> Coeffs2 -> [(VB.Vector Int,Int,Int,String)] -> [VB.Vector Int] -> [String] -> IO ()+generalProcMMs interactiveMM file coeffs rs perms subs+ | null rs = putStrLn "No data has been specified to control the computation process. "+ | otherwise = do+    genVariants <- mapM (generalProcMs coeffs perms subs) rs+    let !lineVs = map (map line) genVariants+        !l3 = length lineVs+    case l3 of+     4 -> finalProc interactiveMM file id ll+       where [!l10,!l20,!l30,!l40] = lineVs+             !l12 = intersectInterResults l10 l20+             !l34 = intersectInterResults l30 l40+             !ll = intersectInterResults l12 l34+     3 -> finalProc interactiveMM file id ll+       where [!l10,!l20,!l30] = lineVs+             !l12 = intersectInterResults l10 l20+             !ll = intersectInterResults l12 l30+     2 -> finalProc interactiveMM file id ll+       where [!l10,!l20] = lineVs+             !ll = intersectInterResults l10 l20+     _ -> putStrLn "You have specified just one variant of the metrices. " >> do+           temp <- generalProcMs coeffs perms subs (head rs)+           finalProc interactiveMM file line temp +finalProc :: Bool -> FilePath -> (a -> String) -> [a] -> IO ()+finalProc bool ys f xss = if bool then interactivePrintResult f ys xss else mapM_ (putStrLn . f) xss+ fLines :: String -> [String] fLines ys =   let preText = filter (any (\x -> isUkrainianL x && isAlpha x)) . prepareText $ ys@@ -164,7 +193,6 @@ 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+ | otherwise = putStrLn (line x) >> putStrLn (showFFloat ch (metrices x) "") >> putStrLn (showFFloat ch (transMetrices x) "") >> print1el False choice xs        where !ch = precChoice choice print1el _ _ _ = return ()

@@ -2,7 +2,7 @@ -- further documentation, see http://haskell.org/cabal/users-guide/  name:                phonetic-languages-simplified-lists-examples-version:             0.2.0.0+version:             0.3.0.0 synopsis:            Simplified and somewhat optimized version of the phonetic-languages-examples. description:         Is intended to use more functionality of lists and subG package. homepage:            https://hackage.haskell.org/package/phonetic-languages-simplified-lists-examples