phonetic-languages-plus 0.5.3.0 → 0.6.0.0

raw patch · 4 files changed

+86/−52 lines, 4 filesdep ~uniqueness-periods-vector-statsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: uniqueness-periods-vector-stats

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• Distribution/Main.hs +9/−15
• Distribution/Processment.hs +69/−34
• phonetic-languages-plus.cabal +3/−3

@@ -46,3 +46,8 @@ ## 0.5.3.0 -- 2022-03-24  * Fifth version revised C. Updated the dependency boundaries to support the latest GHC and Cabal versions.++## 0.6.0.0 -- 2022-05-31++* Sixth version. Added multiple properties mode.+

@@ -1,6 +1,6 @@ -- | -- Module      :  Main--- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- Copyright   :  (c) OleksandrZhabenko 2020-2022 -- License     :  MIT -- Stability   :  Experimental -- Maintainer  :  olexandr543@yahoo.com@@ -9,14 +9,7 @@ -- then for the whole poem prints the hypothesis evaluation information. -- Is used in pair with some other programs, e. g. with propertiesText from uniqueness-periods-vector-exampls package -- or with a new phonetic-languages-ukrainian series.--- The program tries to be more accurate in cases of the lines consisting entirely of the words--- which are unique in phonetic meaning alongside the line. Another hypothesis is for the seventh command line--- argument equal to \"y0\" that the distribution--- of the placement of the actual poetic text in Ukrainian is not one of the standard distributions.--- It can probably have approximately a form of and is different for different authors:------ >    --   --   ----- >   /  \_/  \_/  \+--  -- -- To enable parallel computations (potentially, they can speed up the work), please, run the @distributionText@ executable with -- @+RTS -threaded -RTS@ command line options with possibly @-N@ option inside.@@ -41,12 +34,13 @@ main :: IO () main = do   args00 <- getArgs-  let !args0 = filter (/= "+p") args00+  let !multiprop = any (== "+m") args00 -- If 'True' then uses multiple properties mode.       !pairwisePermutations = any (== "+p") args00-      !args = filter (/= "+W") args0-      !gzS = mconcat . take 1 $ args-      !printInput = mconcat . drop 1 . take 2 $ args-      !whitelines = any (== "+W") args0 -- Usually, if specified -- the third argument+      !whitelines = any (== "+W") args00 -- Usually, if specified -- the third argument+      !args0 = filter (\xs -> xs /= "+p" && xs /= "+m" && xs /= "+W") args00+      !gzS = mconcat . take 1 $ args0+      !printInput = mconcat . drop 1 . take 2 $ args0   contents <- B.getContents-  innerProc pairwisePermutations whitelines gzS printInput contents+  if printInput == "1" then B.putStr contents else B.putStr B.empty+  innerProcG pairwisePermutations whitelines gzS multiprop contents 

@@ -1,6 +1,6 @@ -- | -- Module      :  Distribution.Processment--- Copyright   :  (c) OleksandrZhabenko 2020-2021+-- Copyright   :  (c) OleksandrZhabenko 2020-2022 -- License     :  MIT -- Stability   :  Experimental -- Maintainer  :  olexandr543@yahoo.com@@ -10,14 +10,7 @@ -- Is used in pair with some other programs, e. g. with propertiesTextG3 from phonetic-languages-simplified-examples-array package -- or with a new phonetic-languages-ukrainian series. -- The module contains library functions for the program.--- The program tries to be more accurate in cases of the lines consisting entirely of the words--- which are unique in phonetic meaning alongside the line. Another hypothesis is for the seventh command line--- argument equal to \"y0\" that the distribution--- of the placement of the actual poetic text in Ukrainian is not one of the standard distributions.--- It can probably have approximately a form of and is different for different authors:------ >    --   --   ----- >   /  \_/  \_/  \+--  -- -- To enable parallel computations (potentially, they can speed up the work), please, run the @distributionText@ executable with -- @+RTS -threaded -RTS@ command line options with possibly @-N@ option inside.@@ -36,11 +29,12 @@ #endif #endif import Control.Parallel.Strategies-import Data.Maybe (fromMaybe,mapMaybe)+import Data.Maybe (fromMaybe,isJust,fromJust) import Text.Read (readMaybe) import Numeric (showFFloat) import Data.List (sort) import Numeric.Stats+import Data.Char (isDigit) import qualified Data.ByteString.Char8 as B import Data.Lists.FLines hiding (mconcat) import Data.Statistics.RulesIntervals@@ -52,27 +46,57 @@ #endif #endif -innerProc :: Bool -> Bool -> String -> String -> B.ByteString -> IO ()-innerProc pairwisePermutations whitelines gzS printInput contents = do-  if printInput == "1" then B.putStr contents else B.putStr B.empty-  (!data31,!wordsCnt0_data32) <- processContents whitelines contents-  let !gz = getIntervalsN gzS data31 -- Obtained from the first command line argument except those ones that are for RTS-      !pair2s = zip data31 wordsCnt0_data32-      !data4 = mapMaybe (\(!x,(!y,_)) -> if y > 1 then Just x else Nothing) pair2s-  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 lines that have no variativity from the program perspective and, therefore, they cannot be analyzed effectively by it. Nevertheless, you can accurately exclude them from the consideration. A rather rare occurrence.-  else do-      let (!mean1,!disp) = meanWithDispD2 data4-          !pairs = sort . filter ((/= 0) . snd) $ wordsCnt0_data32+-- | Sum data type to control whether the functions work with multiple properties or with just one.+data ControlStatsIntervals = U ([Double],[(Int,Int)]) | M [(Int,Int)] deriving (Eq,Show)++isU :: ControlStatsIntervals -> Bool+isU (U _) = True+isU _ = False++isM :: ControlStatsIntervals -> Bool+isM (M _) = True+isM _ = False++data31F (U (x,y)) = Just x+data31F (M _) = Nothing++wordsCnt0_data32F (U (x,y)) = y+wordsCnt0_data32F (M y) = y++maybeDII :: (Int -> Bool) -> ControlStatsIntervals -> Maybe [(Double,(Int,Int))]+maybeDII p (U (xs,ys)) = Just . filter (\(_,(y,_)) -> p y) . zip xs $ ys+maybeDII _ _ = Nothing++numberProps :: B.ByteString -> Int+numberProps contents = maximum . map (subtract 1 .  length . filter (B.all isDigit) . B.words) . B.lines $ contents+        +innerProcG :: Bool -> Bool -> String -> Bool -> B.ByteString -> IO ()+innerProcG pairwisePermutations whitelines gzS multiprop contents +   | multiprop  = mapM_ (\i -> processContentsMultiprop i contents >>= \csi -> innerProc pairwisePermutations whitelines gzS csi contents) [1..numberProps contents]+   | otherwise = processContents whitelines contents >>= \csi -> innerProc pairwisePermutations whitelines gzS csi contents++innerProc :: Bool -> Bool -> String -> ControlStatsIntervals -> B.ByteString -> IO ()+innerProc pairwisePermutations whitelines gzS csi contents = do+  if all ((< 2) . fst) . wordsCnt0_data32F $ csi+    then putStrLn (replicate 102 '-') >> putStrLn "1.000+-0.000\tALL!" >> putStrLn (replicate 102 '=') -- Well, this means that all the text consists of the lines that have no variativity from the program perspective and, therefore, they cannot be analyzed effectively by it. Nevertheless, you can accurately exclude them from the consideration. A rather rare occurrence.+    else do+      let !gz+            | isU csi = getIntervalsN gzS (fromJust . data31F $ csi) -- Obtained from the first command line argument except those ones that are for RTS+            | otherwise = getIntervalsN gzS . wordsCnt0_data32F $ csi+          !mndsp+            | isU csi = Just . meanWithDispD2 . map fst . fromJust . maybeDII (>1) $ csi -- Since the 0.6.0.0 version switched to the sample unbiased dispersion with (n - 1) in the denominator.+            | otherwise = Nothing+          !pairs = sort . filter ((/= 0) . snd) . wordsCnt0_data32F $ csi           g !m !n = (length . takeWhile (\(_,v) -> v == n) . dropWhile (\(_,v) -> v /= n) . takeWhile (\(u,_) -> u == m) .               dropWhile (\(u,_) -> u /= m) $ pairs) `using` rdeepseq           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..(if pairwisePermutations then 10 else 7)],replicate 102 x]-      putStrLn . generalInfo1 pairwisePermutations gz pairs (mean1, disp) $ data31+      putStrLn . generalInfo1 pairwisePermutations gz pairs mndsp . length . wordsCnt0_data32F $ csi       putStrLn (h False '~')       putStrLn (h True '=') -processContents :: Bool -> B.ByteString -> IO ([Double],[(Int,Int)])+processContents :: Bool -> B.ByteString -> IO ControlStatsIntervals processContents whitelines contents = do     let !anlines = B.lines contents         !anStrs@@ -84,18 +108,29 @@         !ratios = map (\xs -> fromMaybe 1.0 (readMaybe xs::Maybe Double)) ratioStrs         !wordsNs = map (\xs -> fromMaybe 0 (readMaybe xs::Maybe Int)) wordsNStrs         !intervalNs = map (\xs -> fromMaybe 0 (readMaybe xs::Maybe Int)) intervalNStrs-    return (ratios,zip wordsNs intervalNs)+    return . U $ (ratios,zip wordsNs intervalNs) -generalInfo1 :: Bool -> Int -> [(Int,Int)] -> (Double,Double) -> [Double] -> String-generalInfo1 pairwisePermutations gz pairs (mean1, disp) data31 =+processContentsMultiprop :: Int -> B.ByteString -> IO ControlStatsIntervals+processContentsMultiprop propN contents = do+    let !anwords = map B.words . B.lines $ contents+        !wordsNStrs = map (B.unpack . head) anwords+        !intervalNStrs = map (B.unpack . B.concat . drop propN . take (propN + 1)) anwords+        !wordsNs = drop 1 . filter (> 0) . map (\xs -> fromMaybe 0 (readMaybe xs::Maybe Int)) $ wordsNStrs+        !intervalNs = filter (> 0) . map (\xs -> fromMaybe 0 (readMaybe xs::Maybe Int)) $ intervalNStrs+    return . M . zip wordsNs $ intervalNs++generalInfo1 :: Bool -> Int -> [(Int,Int)] -> Maybe (Double,Double) -> Int -> String+generalInfo1 pairwisePermutations gz pairs mndsp ll =  let !ks = map (\r -> length . takeWhile (== r) . dropWhile (/= r) . sort . map snd $ pairs) [1..gz]-     !s = sum ks in-       mconcat [replicate 102 '-', newLineEnding, mconcat . map (\r -> show r ++ "\t") $ [1..gz], newLineEnding,-        mconcat . map (\r ->  show r ++ "\t") $ ks,-         newLineEnding, mconcat . map (\r -> showFFloat (Just 2) (fromIntegral (r * 100) / fromIntegral s)  "%\t") $ ks,-          newLineEnding, mconcat [showFFloat (Just 4) mean1 "+-", showFFloat (Just 4) (sqrt disp) "\t",-           show (length . filter ((<= 1) . fst) $ pairs), '\t':show (length data31)], newLineEnding,-            mconcat . map (\r -> show r ++ "\t") $ [2..(if pairwisePermutations then 10 else 7)], newLineEnding, mconcat .-              map (\r ->  (show . length . takeWhile (== r) . dropWhile (/= r) . map fst $ pairs) ++ "\t") $+     !s = sum ks+     stringMD+      | isJust mndsp = let (mean1,disp) = fromJust mndsp in mconcat [showFFloat (Just 4) mean1 "+-", showFFloat (Just 4) (sqrt disp) "\t"]+      | otherwise = "" in+        mconcat [replicate 102 '-', newLineEnding, mconcat . map (\r -> show r ++ "\t") $ [1..gz], newLineEnding,+         mconcat . map (\r ->  show r ++ "\t") $ ks,+          newLineEnding, mconcat . map (\r -> showFFloat (Just 2) (fromIntegral (r * 100) / fromIntegral s)  "%\t") $ ks,+           newLineEnding, stringMD, show (length . filter ((<= 1) . fst) $ pairs), '\t':show ll, newLineEnding,+             mconcat . map (\r -> show r ++ "\t") $ [2..(if pairwisePermutations then 10 else 7)], newLineEnding, mconcat .+               map (\r ->  (show . length . takeWhile (== r) . dropWhile (/= r) . map fst $ pairs) ++ "\t") $                 [2..(if pairwisePermutations then 10 else 7)], newLineEnding, replicate 102 '*'] {-# INLINE generalInfo1 #-}

@@ -3,7 +3,7 @@ -- http://haskell.org/cabal/users-guide/  name:                phonetic-languages-plus-version:             0.5.3.0+version:             0.6.0.0 synopsis:            Some common shared between different packages functions. description:         Among them are the uniqueness-periods-vector series. homepage:            https://hackage.haskell.org/package/phonetic-languages-plus@@ -21,7 +21,7 @@   exposed-modules:     Languages.UniquenessPeriods.Vector.AuxiliaryG, Data.Statistics.RulesIntervals,  Data.Statistics.RulesIntervalsPlus, Distribution.Processment   -- other-modules:   other-extensions:    CPP, BangPatterns-  build-depends:       base >=4.8 && <5, bytestring >= 0.10 && <1, lists-flines >=0.1.2 && <1, uniqueness-periods-vector-stats >=0.2.2 && <1, parallel >=3.2.0.6 && <4+  build-depends:       base >=4.8 && <5, bytestring >= 0.10 && <1, lists-flines >=0.1.2 && <1, uniqueness-periods-vector-stats ==0.3.0.0, parallel >=3.2.0.6 && <4   -- hs-source-dirs:   default-language:    Haskell2010 @@ -29,7 +29,7 @@   main-is:             Main.hs   other-modules:       Data.Statistics.RulesIntervals, Data.Statistics.RulesIntervalsPlus, Distribution.Processment   other-extensions:    CPP, BangPatterns-  build-depends:       base >=4.8 && <5, bytestring >= 0.10 && <1, lists-flines >=0.1.2 && <1, uniqueness-periods-vector-stats >=0.2.2 && <1, parallel >=3.2.0.6 && <4+  build-depends:       base >=4.8 && <5, bytestring >= 0.10 && <1, lists-flines >=0.1.2 && <1, uniqueness-periods-vector-stats ==0.3.0.0, parallel >=3.2.0.6 && <4   ghc-options:         -threaded -rtsopts   hs-source-dirs:      ., Distribution   default-language:    Haskell2010