diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for phonetic-languages-plus + +## 0.1.0.0 -- 2020-10-30 + +* First version. Released on an unsuspecting world. diff --git a/Data/Statistics/RulesIntervals.hs b/Data/Statistics/RulesIntervals.hs new file mode 100644 --- /dev/null +++ b/Data/Statistics/RulesIntervals.hs @@ -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 #-} diff --git a/Distribution/Main.hs b/Distribution/Main.hs new file mode 100644 --- /dev/null +++ b/Distribution/Main.hs @@ -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 #-} + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Languages/UniquenessPeriods/Vector/AuxiliaryG.hs b/Languages/UniquenessPeriods/Vector/AuxiliaryG.hs new file mode 100644 --- /dev/null +++ b/Languages/UniquenessPeriods/Vector/AuxiliaryG.hs @@ -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 #-} diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/phonetic-languages-plus.cabal b/phonetic-languages-plus.cabal new file mode 100644 --- /dev/null +++ b/phonetic-languages-plus.cabal @@ -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