uniqueness-periods-vector-examples-0.4.0.0: Proportion/Main.hs

-- |
-- 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. Since the 0.4.0.0 version 
-- 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. 

module Main where

import qualified Data.Vector as V
import String.Languages.UniquenessPeriods.Vector
import Languages.UniquenessPeriods.Vector.General.Debug
import Languages.UniquenessPeriods.Vector.Properties
import Melodics.Ukrainian
import System.Environment
import Languages.Phonetic.Ukrainian.PrepareText
import Languages.UniquenessPeriods.Vector.Data
import Languages.UniquenessPeriods.Vector.Auxiliary
import Languages.UniquenessPeriods.Vector.StrictV
import Numeric (showFFloat)
import Languages.UniquenessPeriods.Vector.Filters
import GHC.Float (int2Float)
import Data.List (sort)

main :: IO ()
main = do
  args <- getArgs
  let file = concat . take 1 $ args
  contents <- readFile file
  let flines = filter (not . null . filter isUkrainian) . prepareText $ contents
  data3 <- mapM (\ts -> do
   let maxE = (\k -> if k == 0 then 1 else k) . (\rs -> if null rs then 0 else head rs) . firstFrom3 . maximumElBy 1 (V.singleton (oneProperty)) $ UL2 ([],uniquenessVariants2GN " 01-" (V.singleton (oneProperty)) (uniquenessPeriodsVector3 " 01-" . 
              aux0 . convertToProperUkrainian) (justOneValue2Property . diverse2) $ ts)
       minE = (\k -> if k == 0 then 1 else k) . abs . (\rs -> if null rs then 0 else head rs) . firstFrom3 . maximumElBy 1 (V.singleton (oneProperty)) $ UL2 ([],uniquenessVariants2GN " 01-" (V.singleton (oneProperty)) (uniquenessPeriodsVector3 " 01-" . 
              aux0 . convertToProperUkrainian) (justOneValue2Property . negate . diverse2) $ ts)
       data2 = (\k -> if k == 0 then 1 else k) . diverse2 . uniquenessPeriodsVector3 " 01-" . aux0 . convertToProperUkrainian $ ts 
   let ratio = if maxE == 1 then 0 else 2.0 * fromIntegral data2 / fromIntegral (minE + maxE)
       intervalN = if maxE == 1 then 0 else intervalNRealFrac (int2Float minE) (int2Float maxE) 9 (int2Float data2)
   putStrLn $ show (minE::Int) ++ "\t" ++ show (data2::Int) ++ "\t" ++ show (maxE::Int) ++ "\t" ++ 
     showFFloat (Just 3) (fromIntegral data2 / fromIntegral minE) "\t" ++ showFFloat (Just 3) (fromIntegral maxE / fromIntegral data2) "\t" ++ 
       showFFloat (Just 3) ratio "\t" ++ show (length . words $ ts) ++ "\t" ++ show intervalN
   return (ratio,intervalN)) $ flines
  let (data31,data32) = unzip data3 
      data4 = filter (/= 0) data31
  if null data4 then putStrLn "-----------------------------------------------------------------------------------------------------" >> putStrLn "1.000+-0.000\t0" >> 
    putStrLn "=====================================================================================================" -- 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 = sum data4 / fromIntegral (length data4)
        intervals = sort . filter (/= 0) $ data32
        zeroes = length . filter (== 0) $ data31
        f xs n = show . length . takeWhile (== n) . dropWhile (/= n) $ xs
    putStrLn "-----------------------------------------------------------------------------------------------------"
    mapM_ (\r -> putStr $ show r ++ "\t") [1..9] >> putStrLn ""
    mapM_ (\r ->  putStr $ f intervals r ++ "\t") [1..9] >> putStrLn ""
    putStrLn $ showFFloat (Just 3) mean1 "+-" ++ showFFloat (Just 3) (sqrt ((sum (map (**2) data4) / fromIntegral (length data4)) - mean1 ** 2)) "\t" ++ show zeroes
    putStrLn "====================================================================================================="
  
isUkrainian :: Char -> Bool
isUkrainian x
 | x == '\x0404' || (x >= '\x0406' && x <= '\x0407') || (x >= '\x0410' && x <= '\x0429') || x == '\x042C' || (x >= '\x042E' && x <= '\x0449') || x == '\x044C' || (x >= '\x044E' && x <= '\x044F') || x == '\x0454' || (x >= '\x0456' && x <= '\x0457') = True
 | otherwise = False