Оптимизация кода на Haskell - PullRequest
16 голосов
/ 26 мая 2010

Я пытаюсь изучить Haskell, и после статьи в reddit о цепочках текста Маркова я решил реализовать генерацию текста Маркова сначала в 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."

Ответы [ 6 ]

11 голосов
/ 26 мая 2010

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

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

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

d) Не конвертировать строки байтов в строку. Сохраняйте их как строки и сохраняйте их на карте

9 голосов
/ 27 мая 2010

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

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

7 голосов
/ 26 мая 2010

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

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"

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

EDIT Согласно очень правильному замечанию Трэвиса Брауна,

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
3 голосов
/ 26 мая 2010

Вот версия на основе 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)

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

2 голосов
/ 26 мая 2010

1) Я не понимаю ваш код. а) Вы определяете «лиса», но не используете его. Вы хотели, чтобы мы попытались помочь вам использовать «лису» вместо чтения файла? б) Вы объявляете это как «модуль Маркова», тогда в модуле есть «главный». в) 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."
1 голос
/ 26 мая 2010

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

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

Выезд: http://book.realworldhaskell.org/read/profiling-and-optimization.html

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

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...