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

Question

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

Я отправлю код Python и Хаскелл. С теми же данными 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." 

Answer 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" 

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

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 

Answer 2

а) Как вы компиляции? (ghc-O2?)

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

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

d) Не конвертируйте bytestrings в String. Держите их как байты, и храните их на карте.

Answer 3

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

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

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

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

Answer 4

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." 

Answer 5

Вот 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), и он производит тот же результат, что и ваша функция. Мое сравнение времени было очень ненаучным, но этот подход, вероятно, стоит посмотреть.

Answer 6

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

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