[haskell][Тормоза]

{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, BangPatterns #-}
module NGram where

import System.Random
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Class
import qualified Data.Map as M
import Control.Arrow
import Data.List (inits, tails, foldl')
import System.Environment

-- На самом деле не случайный а в зависимости от поданного числа. сдесь первый
-- аргумент это число по которому будет выбираться элемент, а в списке кортежей
-- первый элемент кортежа есть относительное значение вероятности для выброки
getRandomElement :: (Num a, Ord a) => a -> [(a, b)] -> Maybe b
getRandomElement _ [] = Nothing
getRandomElement elem xs = let el = min elem $ probSum xs
                           in Just $ snd $ head $ filter (\((l, g), ret) -> el >= l && el <= g) lowHighList
    where
    -- probSum :: (Ord a, Num a) => [(a, b)] -> a
    probSum = sum . map fst
    -- lowHighList :: (Random a, Num a, Ord a) => [((a, a), b)]
    lowHighList = map (((\x -> (probSum x) - (last $ map fst x)) &&& probSum) &&& (last . map snd)) $
                   tail $ inits xs

-- Указываем длинну нграммы и список элементов (строку) получаем словарь где
-- ключем является строка а значением ее относительная вероятность появления
makeNgram :: (Ord a, Num b) => Int -> [a] -> M.Map [a] b
makeNgram n str = foldl' foldf M.empty $ nlists n str
  where
    foldf m s = M.insertWith (+) s 1 m
    nlists :: Int -> [a] -> [[a]]
    nlists n str = map (take n)
                   $ take (length str + 1 - n)
                   $ tails str

-- Эта функция использует только одно IO действие - взятие случайного числа
generateSeq :: (Random b, Ord b, Num b) => Int -> M.Map [a] b -> MaybeT IO [a]
generateSeq amount ng = do
  let mlist = map (snd &&& fst) $ M.toList ng
  let fsum = sum $ map fst mlist
  gen <- lift newStdGen          -- вот тут
  let rnds = take amount $ randomRs (0, fsum) gen
  MaybeT . return $ (mapM (\x -> getRandomElement x mlist) rnds) >>= return . concat

module Main where

import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Class (lift)
import Data.Map as M
import System.Environment
import System.IO
import NGram

main = do
  a <- getArgs
  if length a /= 2
    then usage
    else do let len = read $ a !! 0
            cont <- readFile $ a !! 1
            let result = show ((makeNgram len cont) :: M.Map String Double)
            putStrLn result
              

usage :: IO ()
usage = putStrLn "Need 2 arguments :: length filename"

18:39 razor@localhost /home/razor/projs/haskell/ngrams % du -h data.txt          
12K     data.txt
18:40 razor@localhost /home/razor/projs/haskell/ngrams % time ./nggen 4 data.txt > out
./nggen 4 data.txt > out  0,06s user 0,01s system 80% cpu 0,082 total

module Main where

import System.Environment
import System.IO
import Control.Monad.Trans.Maybe (runMaybeT)
import Control.Monad.Trans.Class (lift)
import Control.DeepSeq
import Data.Map as M
import NGram
  

main = runMaybeT $ do
  args <- lift $ getArgs
  if length args /= 3
    then lift usage
    else do let len = read $ args !! 0
            let amount = read $ args !! 1
            hfile <- lift $ openFile (args !! 2) ReadMode
            cont <- lift $ hGetContents hfile
            cont `deepseq` lift $ hClose hfile
            out <- generateSeq amount $ (makeNgram len cont :: M.Map String Int)
            lift $ putStrLn out

usage :: IO ()
usage = putStrLn "Need 3 arguments length, amount and filename"

18:43 razor@localhost /home/razor/projs/haskell/ngrams % time ./ngfilter 4 2 data.txt > out
./ngfilter 4 2 data.txt > out  4,05s user 0,01s system 99% cpu 4,067 total
18:45 razor@localhost /home/razor/projs/haskell/ngrams % time ./ngfilter 4 3 data.txt > out
./ngfilter 4 3 data.txt > out  16,85s user 0,05s system 99% cpu 16,930 total
18:45 razor@localhost /home/razor/projs/haskell/ngrams % time ./ngfilter 4 10 data.txt > out
./ngfilter 4 10 data.txt > out  40,86s user 0,11s system 99% cpu 41,044 total