packages feed

phonetic-languages-plus (empty) → 0.1.0.0

raw patch · 7 files changed

+239/−0 lines, 7 filesdep +basedep +bytestringdep +lists-flinessetup-changed

Dependencies added: base, bytestring, lists-flines, parallel, uniqueness-periods-vector-stats

Files

+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for phonetic-languages-plus++## 0.1.0.0 -- 2020-10-30++* First version. Released on an unsuspecting world.
+ Data/Statistics/RulesIntervals.hs view
@@ -0,0 +1,39 @@+-- |+-- Module      :  Data.Statistics.RulesIntervals+-- Copyright   :  (c) OleksandrZhabenko 2020+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- Additional statistic rules to choose the number of the intervals.++{-# LANGUAGE BangPatterns #-}++module Data.Statistics.RulesIntervals where++import Data.Lists.FLines (newLineEnding)+import GHC.Real (ceiling)+import GHC.Float (int2Float)++sturgesH :: Int -> Int+sturgesH n+  | compare n 0 == GT = ceiling (logBase 2 (int2Float n))+  | otherwise = error $ "sturgesH: undefined for the argument " ++ show n ++ newLineEnding+{-# INLINE sturgesH #-}++-- | 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 = sturgesH 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 #-}
+ Distribution/Main.hs view
@@ -0,0 +1,107 @@+-- |+-- Module      :  Main+-- Copyright   :  (c) OleksandrZhabenko 2020+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- Analyzes a poetic text in Ukrainian, for every line prints statistic data and+-- 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.+--++{-# OPTIONS_GHC -threaded -rtsopts #-}++{-# LANGUAGE CPP, BangPatterns #-}++module Main where++#ifdef __GLASGOW_HASKELL__+#if __GLASGOW_HASKELL__>=710+/* code that applies only to GHC 7.10.* and higher versions */+import GHC.Base (mconcat)+#endif+#endif+import Control.Parallel.Strategies+import Data.Maybe (fromMaybe)+import Text.Read (readMaybe)+import System.Environment+import Numeric (showFFloat)+import Data.List (sort)+import Numeric.Stats+import qualified Data.ByteString.Char8 as B+import Data.Lists.FLines hiding (mconcat)+import Data.Statistics.RulesIntervals+#ifdef __GLASGOW_HASKELL__+#if __GLASGOW_HASKELL__==708+/* code that applies only to GHC 7.8.* */+mconcat = concat+#endif+#endif++main :: IO ()+main = do+  args <- getArgs+  let !gzS = concat . take 1 $ args+      !printInput = concat . drop 1 . take 2 $ args+  contents <- B.getContents+  innerProc gzS printInput contents++innerProc :: String -> String -> B.ByteString -> IO ()+innerProc gzS printInput contents = do+  if printInput == "1" then B.putStr contents else B.putStr B.empty+  (!data31,!wordsCnt0_data32) <- processContents contents +  let !gz = getIntervalsN gzS data31 -- Obtained from the first command line argument except those ones that are for RTS+      !data4 = filter (/= 0.0) 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` 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..7],replicate 102 x]+      putStrLn . generalInfo1 gz pairs (mean1, disp) $ data31+      putStrLn (h False '~')+      putStrLn (h True '=')++getIntervalsN :: String -> [a] -> Int+getIntervalsN xs yss+  | xs == "s" = sturgesH (length yss)+  | xs == "l" = levynskyiMod (length yss)+  | otherwise = fromMaybe 9 (readMaybe xs::(Maybe Int))+{-# INLINE getIntervalsN #-}++processContents :: B.ByteString -> IO ([Float],[(Int,Int)])+processContents contents = do+  let !anlines = B.lines contents+      !anStrs = map (drop 6 . take 9 . B.words) anlines+      !ratioStrs = map (B.unpack . head) anStrs+      !wordsNStrs = map (B.unpack . (!! 1)) anStrs+      !intervalNStrs = map (B.unpack . last) anStrs+      !ratios = map (\xs -> fromMaybe 1.0 (readMaybe xs::Maybe Float)) 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)+  +generalInfo1 :: Int -> [(Int,Int)] -> (Float,Float) -> [Float] -> String+generalInfo1 gz pairs (mean1, disp) data31 =+ 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 (== 0.0) $ data31),+           '\t':show (length data31)], newLineEnding, mconcat . map (\r -> show r ++ "\t") $ [2..7], newLineEnding, mconcat .+              map (\r ->  (show . length . takeWhile (== r) . dropWhile (/= r) . map fst $ pairs) ++ "\t") $ [2..7], newLineEnding, replicate 102 '*']+{-# INLINE generalInfo1 #-}+
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2020 OleksandrZhabenko++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Languages/UniquenessPeriods/Vector/AuxiliaryG.hs view
@@ -0,0 +1,31 @@+-- |+-- Module      :  Languages.UniquenessPeriods.Vector.AuxiliaryG+-- Copyright   :  (c) OleksandrZhabenko 2020+-- License     :  MIT+-- Stability   :  Experimental+-- Maintainer  :  olexandr543@yahoo.com+--+-- Is from the @dobutokO-poetry-general@ package. Is included here +-- to minimize dependencies of the package. +-- Similar functionality is provided by the packages MissingH, extra, ghc +-- and other packages, but they have a lot of dependencies, so here there are +-- less dependencies module and package.++module Languages.UniquenessPeriods.Vector.AuxiliaryG (+  -- * Help functions+  lastFrom3+  , firstFrom3+  , secondFrom3+) where++lastFrom3 :: (a,b,c) -> c+lastFrom3 (_,_,z) = z+{-# INLINE lastFrom3 #-}++firstFrom3 :: (a, b, c) -> a+firstFrom3 (x, _, _) = x+{-# INLINE firstFrom3 #-}++secondFrom3 :: (a, b, c) -> b+secondFrom3 (_, y, _) = y+{-# INLINE secondFrom3 #-}
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ phonetic-languages-plus.cabal view
@@ -0,0 +1,35 @@+-- Initial uniqueness-periods-vector-examples.cabal generated by cabal+-- init.  For further documentation, see+-- http://haskell.org/cabal/users-guide/++name:                phonetic-languages-plus+version:             0.1.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+license:             MIT+license-file:        LICENSE+author:              OleksandrZhabenko+maintainer:          olexandr543@yahoo.com+copyright:           Oleksandr Zhabenko+category:            Language, Math, Game+build-type:          Simple+extra-source-files:  ChangeLog.md+cabal-version:       >=1.10++library+  exposed-modules:     Languages.UniquenessPeriods.Vector.AuxiliaryG, Data.Statistics.RulesIntervals+  -- other-modules:+  other-extensions:    BangPatterns+  build-depends:       base >=4.7 && <4.15, lists-flines >=0.1.1 && <1+  -- hs-source-dirs:+  default-language:    Haskell2010++executable distributionTextG+  main-is:             Main.hs+  other-modules:       Data.Statistics.RulesIntervals+  other-extensions:    CPP, BangPatterns+  build-depends:       base >=4.7 && <4.15, bytestring >=0.10 && <0.13, parallel >=3.2.0.6 && <4, lists-flines >=0.1.1 && <1, uniqueness-periods-vector-stats >=0.1.2 && <1+  ghc-options:         -threaded -rtsopts+  hs-source-dirs:      ., Distribution+  default-language:    Haskell2010