uniqueness-periods-vector-examples 0.7.2.0 → 0.8.0.0
raw patch · 3 files changed
+81/−25 lines, 3 filesdep +lists-flinesnew-component:exe:lineVariantsnew-component:exe:processTextnew-component:exe:rewritePoem
Dependencies added: lists-flines
Files
- ChangeLog.md +9/−0
- Proportion/Main.hs +66/−19
- uniqueness-periods-vector-examples.cabal +6/−6
ChangeLog.md view
@@ -75,3 +75,12 @@ * Seventh version revised B. Added additional information so that also is displayed the percentages of intervals in the uniqVec03 executable. Parallelization (and mostly performance) optimizations for uniqVec03 executable.++## 0.8.0.0 -- 2020-10-05++* Eigth version. Added a new way to compare the results for processment of the uniqVec03 executable. Added the fifth command line argument to control this+comparisons. Added a new lightweight dependency of lists-flines. Changed the names of the executables.+uniqVec01 -> linVariants+uniqVec02 -> rewritePoem+uniqVec03 -> processText+
Proportion/Main.hs view
@@ -21,7 +21,7 @@ {-# OPTIONS_GHC -threaded -rtsopts #-} -{-# LANGUAGE CPP, BangPatterns #-}+{-# LANGUAGE CPP, BangPatterns, FlexibleInstances, MultiParamTypeClasses #-} module Main where @@ -36,7 +36,7 @@ import Text.Read (readMaybe) import qualified Data.Vector as V import String.Languages.UniquenessPeriods.Vector-import Languages.UniquenessPeriods.Vector.General.Debug+import Languages.UniquenessPeriods.Vector.General.Debug hiding (newLineEnding) import Languages.UniquenessPeriods.Vector.Properties import Melodics.Ukrainian import System.Environment@@ -47,6 +47,7 @@ import Numeric (showFFloat) import Languages.UniquenessPeriods.Vector.Filters import GHC.Float (int2Float)+import GHC.Real (ceiling) import Data.List (sort) import Data.Char (isAlpha) import Numeric.Stats@@ -56,29 +57,75 @@ mconcat = concat #endif #endif+import Data.Lists.FLines +instance GetTransL (FLines [String]) [String] where+ getTL g (F1 xss) = g xss+ getTL g (FL xsss) = mconcat . map g $ xsss+ main :: IO () main = do args <- getArgs let !file = concat . take 1 $ args -- The first command line arguments except those ones that are RTS arguments- !gz = fromMaybe 9 (readMaybe (concat . take 1 . drop 1 $ args)::(Maybe Int)) -- The second command line arguments except those ones that are RTS arguments- !printLine = fromMaybe 0 (readMaybe (concat . take 1 . drop 2 $ args)::(Maybe Int)) -- The third command line arguments except those ones that are RTS arguments. Set to 1 if you would like to print the current line within the information- !toOneLine = fromMaybe 0 (readMaybe (concat . take 1 . drop 3 $ args)::(Maybe Int)) -- The fourth command line arguments except those ones that are RTS arguments. Seti to 1 if you would like to convert the text into one single line before applying to it the processment (it can be more conceptually consistent in such a case)+ !printLine = fromMaybe 0 (readMaybe (concat . take 1 . drop 2 $ args)::(Maybe Int)) -- The third command line argument except those ones that are RTS arguments. Set to 1 if you would like to print the current line within the information+ !toOneLine = fromMaybe 0 (readMaybe (concat . take 1 . drop 3 $ args)::(Maybe Int)) -- The fourth command line argument except those ones that are RTS arguments. Set to 1 if you would like to convert the text into one single line before applying to it the processment (it can be more conceptually consistent in such a case)+ !compareMode = fromMaybe 0 (readMaybe (concat . take 1 . drop 4 $ args)::(Maybe Int)) -- The fifth command line argument except those ones that are RTS arguments. Set to 1 if you would like to print the original version and the concatenated one's (into one line) analyses.+ !gzS = concat . take 1 . drop 1 $ args contents <- readFile file- let !flines = fLines toOneLine contents- (!data31,!wordsCnt0_data32) = unzip . getData3 printLine gz $ flines- !data4 = filter (/= 0) . map fst $ data31- if null data4 then putStrLn (replicate 102 '-') >> putStrLn "1.000+-0.000\tALL!" >> putStrLn (replicate 102 '=') -- Well, this means that all the text consists of the unique (in phonetic meaning) words alongside every line. A rather rare occurrence.- else do- let (!mean1,!disp) = meanWithDisp data4- !pairs = sort . filter ((/= 0) . snd) $ wordsCnt0_data32- g !m !n = (length . takeWhile (\(_,v) -> v == n) . dropWhile (\(_,v) -> v /= n) . takeWhile (\(u,_) -> u == m) . dropWhile (\(u,_) -> u /= m) $ pairs) `using` rseq- h !y !x = mconcat [mconcat . map (\m1 -> mconcat [mconcat . map (\n1 -> (if y then show (g m1 n1) else if g m1 n1 == 0 then "." else show (g m1 n1)) ++ "\t") $ [1..gz],newLineEnding]) $ [2..7],replicate 102 x]- mapM_ putStrLn . map snd $ data31- putStrLn . generalInfo1 gz pairs (mean1, disp) $ data31- putStrLn (h False '~')- putStrLn (h True '=')+ if compareMode == 0 then do+ let !flines = fLines toOneLine contents+ innerProc printLine flines gzS+ else let !flines1 = fLines 1 contents in do+ innerProc printLine flines1 gzS+ let !flines2 = fLines 0 contents+ innerProc printLine flines2 gzS +innerProc :: Int -> [String] -> String -> IO ()+innerProc printLine flInes gzS = do+ let !gz = getIntervalsN gzS flInes -- Obtained from the second command line argument except those ones that are for RTS+ (!data31,!wordsCnt0_data32) = unzip . getData3 printLine gz $ flInes+ !data4 = filter (/= 0) . map fst $ data31+ if null data4 then putStrLn (replicate 102 '-') >> putStrLn "1.000+-0.000\tALL!" >> putStrLn (replicate 102 '=') -- Well, this means that all the text consists of the unique (in phonetic meaning) words alongside every line. A rather rare occurrence.+ else do+ let (!mean1,!disp) = meanWithDisp data4+ !pairs = sort . filter ((/= 0) . snd) $ wordsCnt0_data32+ g !m !n = (length . takeWhile (\(_,v) -> v == n) . dropWhile (\(_,v) -> v /= n) . takeWhile (\(u,_) -> u == m) . dropWhile (\(u,_) -> u /= m) $ pairs) `using` rseq+ h !y !x = mconcat [mconcat . map (\m1 -> mconcat [mconcat . map (\n1 -> (if y then show (g m1 n1) else if g m1 n1 == 0 then "." else show (g m1 n1)) ++ "\t") $ [1..gz],newLineEnding]) $ [2..7],replicate 102 x]+ mapM_ putStrLn . map snd $ data31+ putStrLn . generalInfo1 gz pairs (mean1, disp) $ data31+ putStrLn (h False '~')+ putStrLn (h True '=')++getIntervalsN :: String -> [String] -> Int+getIntervalsN xs yss+ | xs == "s" = sterdgess (length yss)+ | xs == "l" = levynskyiMod (length yss)+ | otherwise = fromMaybe 9 (readMaybe xs::(Maybe Int))+{-# INLINE getIntervalsN #-}++sterdgess :: Int -> Int+sterdgess n+ | compare n 0 == GT = ceiling (3.322 * logBase 10 (int2Float n)) + 1+ | otherwise = error $ "sterdgess: undefined for the argument " ++ show n ++ newLineEnding+{-# INLINE sterdgess #-}++-- | According to @В. П. Левинський@ (V. P. Levynskyi) from @Опря А. Т. Статистика (модульний варіант з програмованою формою контролю знань).+-- Навч. посіб. --- К.: Центр учбової літератури, 2012. --- 448 с. ISBN 978-611-01-0266-7@) page 60. Always return odd values.+levynskyiMod :: Int -> Int+levynskyiMod n+ | compare n 100 == LT = g n+ | compare n 200 == LT = 11+ | compare n 300 == LT = 13+ | compare n 400 == LT = 15+ | compare n 500 == LT = 17+ | otherwise = let !k = sterdgess n in if even k then k + 7 else k + 8+ where g n+ | compare n 60 == GT = 9+ | compare n 40 == GT = 7+ | compare n 20 == GT = 5+ | otherwise = 3+{-# INLINABLE levynskyiMod #-}+ getData3 :: Int -> Int -> [String] -> [((Float,String),(Int,Int))] getData3 printLine gz = parMap rseq (\ts -> let (!maxE,!minE,!data2) = runEval ((parTuple3 rpar rseq rseq) ((\k -> if k == 0 then 1 else k) . (\rs -> if null rs then 0 else head rs) . firstFrom3 .@@ -97,7 +144,7 @@ {-# INLINABLE getData3 #-} fLines :: Int -> String -> [String]-fLines !toOneLine = filter (any (\x -> isUkrainian x && isAlpha x)) . prepareText . (\z -> if toOneLine == 1 then unwords . words $ z else z)+fLines !toOneLine = getTL (filter (any (\x -> isUkrainian x && isAlpha x))) . F1 . prepareText . (\z -> if toOneLine == 1 then unwords . words $ z else z) {-# INLINE fLines #-} generalInfo1 :: Int -> [(Int,Int)] -> (Float,Float) -> [(Float,String)] -> String
uniqueness-periods-vector-examples.cabal view
@@ -3,7 +3,7 @@ -- http://haskell.org/cabal/users-guide/ name: uniqueness-periods-vector-examples-version: 0.7.2.0+version: 0.8.0.0 synopsis: Usage examples for the uniqueness-periods-vector series of packages description: Usage examples for the uniqueness-periods-vector series of packages. Several executables are planned to demonstrate the libraries work. homepage: https://hackage.haskell.org/package/uniqueness-periods-vector-examples@@ -17,7 +17,7 @@ extra-source-files: ChangeLog.md, README.md cabal-version: >=1.10 -executable uniqVec01+executable lineVariants main-is: Main.hs -- other-modules: -- other-extensions:@@ -25,7 +25,7 @@ hs-source-dirs: Simple default-language: Haskell2010 -executable uniqVec02+executable rewritePoem main-is: Main.hs -- other-modules: -- other-extensions:@@ -33,11 +33,11 @@ hs-source-dirs: Lines default-language: Haskell2010 -executable uniqVec03+executable processText main-is: Main.hs -- other-modules:- other-extensions: CPP, BangPatterns- build-depends: base >=4.7 && <4.15, mmsyn6ukr >=0.8.1 && <1, vector >=0.11 && <0.14, uniqueness-periods-vector >=0.3 && <1, uniqueness-periods-vector-general >=0.4.4 && < 1, uniqueness-periods-vector-common >=0.4 && <1, uniqueness-periods-vector-properties >=0.3.1 && <1, print-info >=0.1.3 && <1, phonetic-languages-ukrainian >=0.2.2 && <1, uniqueness-periods-vector-filters >=0.2 && <1, uniqueness-periods-vector-stats >=0.1.2 && <1, parallel >=3.2.0.6 && <4+ other-extensions: CPP, BangPatterns, FlexibleInstances, MultiParamTypeClasses+ build-depends: base >=4.7 && <4.15, mmsyn6ukr >=0.8.1 && <1, vector >=0.11 && <0.14, uniqueness-periods-vector >=0.3 && <1, uniqueness-periods-vector-general >=0.4.4 && < 1, uniqueness-periods-vector-common >=0.4 && <1, uniqueness-periods-vector-properties >=0.3.1 && <1, print-info >=0.1.3 && <1, phonetic-languages-ukrainian >=0.2.2 && <1, uniqueness-periods-vector-filters >=0.2 && <1, uniqueness-periods-vector-stats >=0.1.2 && <1, parallel >=3.2.0.6 && <4, lists-flines >=0.1.1 && <1 ghc-options: -threaded -rtsopts hs-source-dirs: Proportion default-language: Haskell2010