Подтвердить что ты не робот

Оптимизация кода Haskell

Я пытаюсь изучить Haskell и после статьи в reddit о текстовых цепочках Маркова, я решил реализовать генерацию текста Markov сначала на Python и теперь в Haskell. Однако я заметил, что моя реализация python намного быстрее, чем версия Haskell, даже Haskell скомпилирован в собственный код. Мне интересно, что я должен сделать, чтобы код Haskell работал быстрее, и на данный момент я считаю это намного медленнее из-за использования Data.Map вместо hashmaps, но я не уверен.

Я также опубликую код Python и Haskell. С теми же данными Python занимает около 3 секунд, а Haskell ближе к 16 секундам.

Без самовыражения я буду принимать конструктивную критику:).

import random
import re
import cPickle
class Markov:
    def __init__(self, filenames):
        self.filenames = filenames
        self.cache = self.train(self.readfiles())
        picklefd = open("dump", "w")
        cPickle.dump(self.cache, picklefd)
        picklefd.close()

    def train(self, text):
        splitted = re.findall(r"(\w+|[.!?',])", text)
        print "Total of %d splitted words" % (len(splitted))
        cache = {}
        for i in xrange(len(splitted)-2):
            pair = (splitted[i], splitted[i+1])
            followup = splitted[i+2]
            if pair in cache:
                if followup not in cache[pair]:
                    cache[pair][followup] = 1
                else:
                    cache[pair][followup] += 1
            else:
                cache[pair] = {followup: 1}
        return cache

    def readfiles(self):
        data = ""
        for filename in self.filenames:
            fd = open(filename)
            data += fd.read()
            fd.close()
        return data

    def concat(self, words):
        sentence = ""
        for word in words:
            if word in "'\",?!:;.":
                sentence = sentence[0:-1] + word + " "
            else:
                sentence += word + " "
        return sentence

    def pickword(self, words):
        temp = [(k, words[k]) for k in words]
        results = []
        for (word, n) in temp:
            results.append(word)
            if n > 1:
                for i in xrange(n-1):
                    results.append(word)
        return random.choice(results)

    def gentext(self, words):
        allwords = [k for k in self.cache]
        (first, second) = random.choice(filter(lambda (a,b): a.istitle(), [k for k in self.cache]))
        sentence = [first, second]
        while len(sentence) < words or sentence[-1] is not ".":
            current = (sentence[-2], sentence[-1])
            if current in self.cache:
                followup = self.pickword(self.cache[current])
                sentence.append(followup)
            else:
                print "Wasn't able to. Breaking"
                break
        print self.concat(sentence)

Markov(["76.txt"])

-

module Markov
( train
, fox
) where

import Debug.Trace
import qualified Data.Map as M
import qualified System.Random as R
import qualified Data.ByteString.Char8 as B


type Database = M.Map (B.ByteString, B.ByteString) (M.Map B.ByteString Int)

train :: [B.ByteString] -> Database
train (x:y:[]) = M.empty
train (x:y:z:xs) = 
     let l = train (y:z:xs)
     in M.insertWith' (\new old -> M.insertWith' (+) z 1 old) (x, y) (M.singleton z 1) `seq` l

main = do
  contents <- B.readFile "76.txt"
  print $ train $ B.words contents

fox="The quick brown fox jumps over the brown fox who is slow jumps over the brown fox who is dead."
4b9b3361

Ответ 1

Я старался не делать ничего необычного или тонкого. Это всего лишь два подхода к выполнению группировки; первый подчеркивает соответствие шаблонов, второй - нет.

import Data.List (foldl')
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as B

type Database2 = M.Map (B.ByteString, B.ByteString) (M.Map B.ByteString Int)

train2 :: [B.ByteString] -> Database2
train2 words = go words M.empty
    where go (x:y:[]) m = m
          go (x:y:z:xs) m = let addWord Nothing   = Just $ M.singleton z 1
                                addWord (Just m') = Just $ M.alter inc z m'
                                inc Nothing    = Just 1
                                inc (Just cnt) = Just $ cnt + 1
                            in go (y:z:xs) $ M.alter addWord (x,y) m

train3 :: [B.ByteString] -> Database2
train3 words = foldl' update M.empty (zip3 words (drop 1 words) (drop 2 words))
    where update m (x,y,z) = M.alter (addWord z) (x,y) m
          addWord word = Just . maybe (M.singleton word 1) (M.alter inc word)
          inc = Just . maybe 1 (+1)

main = do contents <- B.readFile "76.txt"
          let db = train3 $ B.words contents
          print $ "Built a DB of " ++ show (M.size db) ++ " words"

Я думаю, что они оба быстрее оригинальной версии, но, по общему признанию, я только пробовал их против первого разумного тела, которое я нашел.

ИЗМЕНИТЬ Согласно Трэвису Брауну очень достоверная точка,

train4 :: [B.ByteString] -> Database2
train4 words = foldl' update M.empty (zip3 words (drop 1 words) (drop 2 words))
    where update m (x,y,z) = M.insertWith (inc z) (x,y) (M.singleton z 1) m
          inc k _ = M.insertWith (+) k 1

Ответ 2

a) Как вы его компилируете? (ghc-O2?)

b) Какая версия GHC?

c) Data.Map довольно эффективен, но вас можно обмануть в ленивые обновления - используйте insertWith ', а не insertWithKey.

d) Не конвертируйте bytestrings в String. Храните их как байты и сохраняйте их на карте

Ответ 3

Data.Map разработан в предположении, что сравнение классов Ord занимает постоянное время. Для строковых ключей это может быть не так: mdash, и когда строки равны, это никогда не бывает. Вы можете или не можете столкнуться с этой проблемой в зависимости от того, насколько велик ваш корпус и сколько слов имеют общие префиксы.

У меня возникнет соблазн попробовать структуру данных, предназначенную для работы с ключами последовательности, например, bytestring-trie пакет, предложенный Дон Стюарт.

Ответ 4

Здесь версия foldl', которая, кажется, примерно в два раза быстрее вашего train:

train' :: [B.ByteString] -> Database
train' xs = foldl' (flip f) M.empty $ zip3 xs (tail xs) (tail $ tail xs)
  where
    f (a, b, c) = M.insertWith (M.unionWith (+)) (a, b) (M.singleton c 1)

Я попробовал это в проекте Gutenberg Huckleberry Finn (который я предполагаю, это ваш 76.txt), и он производит тот же результат, что и ваша функция. Мое сравнение времени было очень ненаучным, но этот подход, вероятно, стоит посмотреть.

Ответ 5

1) Я не понимаю ваш код. a) Вы определяете "лису", но не используете ее. Было ли у вас для нас смысл попытаться помочь вам использовать "лису" вместо того, чтобы читать файл? b) Вы объявляете это как "модуль Маркова", а затем "основной" в модуле. c) System.Random не требуется. Это помогает нам помочь вам, если вы немного очистите код перед публикацией.

2) Используйте ByteStrings и некоторые строгие операции, как сказал Дон.

3) Скомпилируйте с -O2 и используйте -fforce-recomp, чтобы убедиться, что вы действительно перекомпилировали код.

4) Попробуйте это небольшое преобразование, оно работает очень быстро (0,005 секунды). Очевидно, что вход абсурдно мал, поэтому вам нужно предоставить свой файл или просто проверить его самостоятельно.

{-# LANGUAGE OverloadedStrings, BangPatterns #-}
module Main where

import qualified Data.Map as M
import qualified Data.ByteString.Lazy.Char8 as B


type Database = M.Map (B.ByteString, B.ByteString) (M.Map B.ByteString Int)

train :: [B.ByteString] -> Database
train xs = go xs M.empty
  where
  go :: [B.ByteString] -> Database -> Database
  go (x:y:[]) !m = m
  go (x:y:z:xs) !m =
     let m' =  M.insertWithKey' (\key new old -> M.insertWithKey' (\_ n o -> n + 1) z 1 old) (x, y) (M.singleton z 1) m
     in go (y:z:xs) m'

main = print $ train $ B.words fox

fox="The quick brown fox jumps over the brown fox who is slow jumps over the brown fox who is dead."

Ответ 6

Как предложил Дон, изучите использование более строгих версий o своих функций: insertWithKey '(и M.insertWith ", так как в любом случае вы игнорируете ключевой параметр во второй раз).

Похоже, что ваш код, вероятно, накапливает много трюков, пока не дойдет до конца вашего [String].

Отъезд: http://book.realworldhaskell.org/read/profiling-and-optimization.html

... особенно попробуйте графику кучи (примерно на полпути через главу). Заинтересованы в том, что вы выяснили.