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

Я пытаюсь изучить Haskell и после статьи в reddit о текстовых цепочках Маркова, я решил реализовать порождение текста Маркова сначала в Python и теперь в Haskell. Однако я заметил, что моя реализация Python является путем быстрее, чем версия Haskell, даже Haskell компилируется в собственный код. Я задаюсь вопросом, что я должен сделать, чтобы заставить код Haskell работать быстрее, и на данный момент я полагаю, что это настолько медленнее из-за использования Данных. Карта вместо 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."
16
задан Masse 26 May 2010 в 18:20
поделиться

6 ответов

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

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
7
ответ дан 30 November 2019 в 17:14
поделиться

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

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

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

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

11
ответ дан 30 November 2019 в 17:14
поделиться

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

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

Проверьте: http://book.realworldhaskell.org/read/profiling-and-optimization.html

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

1
ответ дан 30 November 2019 в 17:14
поделиться

Вот версия на основе foldl ', которая кажется примерно в два раза быстрее, чем ваш поезд :

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

3
ответ дан 30 November 2019 в 17:14
поделиться

1) Мне непонятен ваш код. а) Вы определяете слово «лиса», но не используете его. Вы хотели, чтобы мы попытались помочь вам использовать слово «лиса» вместо чтения файла? б) Вы объявляете это как «модуль Маркова», тогда в модуле есть «главный». в) System.Random не нужен. Это действительно поможет нам помочь вам, если вы немного очистите код перед публикацией.

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

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."
2
ответ дан 30 November 2019 в 17:14
поделиться

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

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

9
ответ дан 30 November 2019 в 17:14
поделиться
Другие вопросы по тегам:

Похожие вопросы: