performance - Optimizando el código de Haskell

optimization

Question

Estoy tratando de aprender Haskell y después de un artículo en reddit sobre las cadenas de texto de Markov, decidí implementar la generación de texto de Markov primero en Python y ahora en Haskell. Sin embargo, me di cuenta de que mi implementación de Python es mucho más rápida que la versión de Haskell, incluso Haskell está compilada a código nativo. Me pregunto qué debería hacer para que el código de Haskell se ejecute más rápido y por ahora creo que es mucho más lento debido al uso de Data.Map en lugar de los hashmaps, pero no estoy seguro

Voy a publicar el código de Python y Haskell también. Con los mismos datos, Python tarda alrededor de 3 segundos y Haskell está cerca de los 16 segundos.

No hace falta decir que aceptaré cualquier crítica constructiva :).

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

1) No tengo claro tu código. a) Defines "zorro" pero no lo usas. ¿Querías que intentáramos ayudarte a usar "fox" en lugar de leer el archivo? b) Usted declara esto como "módulo Markov" y luego tiene una ''principal'' en el módulo. c) System.Random no es necesario. Nos ayuda si lo limpiamos un poco antes de publicarlo.

2) Use ByteStrings y algunas operaciones estrictas como dijo Don.

3) Compile con -O2 y use -fforce-recomp para asegurarse de que realmente recompiló el código.

4) Prueba esta ligera transformación, funciona muy rápido (0.005 segundos). Obviamente, la entrada es absurdamente pequeña, por lo que necesitaría proporcionar su archivo o simplemente probarlo usted mismo.

{-# 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 2

Aquí hay una versión basada en foldl'' que parece ser casi el doble de rápida que tu 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)

Lo probé en el Proyecto Gutenberg Huckleberry Finn (que asumo que es su 76.txt ), y produce el mismo resultado que su función. Mi comparación de tiempo fue muy poco científica, pero este enfoque probablemente vale la pena echarle un vistazo.

Answer 3

Como Don sugirió, considere usar las versiones más estrictas de sus funciones: insertWithKey ''(y M.insertWith'', ya que de todos modos ignora la clave param la segunda vez).

Parece que tu código probablemente acumula muchos thunks hasta que llega al final de tu [String] .

Echa un vistazo a: http://book.realworldhaskell.org/read/profiling-and-optimization.html

... especialmente, trate de graficar el montón (aproximadamente a la mitad del capítulo). Interesado en ver lo que descubres.

Answer 4

Intenté evitar hacer algo sofisticado o sutil. Estos son solo dos enfoques para hacer la agrupación; el primero hace hincapié en la coincidencia de patrones, el segundo no lo hace.

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"

Creo que ambos son más rápidos que la versión original, pero debo admitir que solo los probé contra el primer corpus razonable que encontré.

EDITAR según el punto muy válido de Travis Brown,

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 5

a) ¿Cómo lo estás compilando? (ghc -O2?)

b) ¿Qué versión de GHC?

c) Data.Map es bastante eficiente, pero puede ser engañado para hacer actualizaciones perezosas - use insertWith '', no insertWithKey.

d) No convierta las secuencias de caracteres a String. Manténgalos como secuencias de bytes y guárdelos en el Mapa.

Answer 6

Data.Map está diseñado bajo el supuesto de que las comparaciones de clase Ord toman tiempo constante. Para las claves de cadena, esto puede no ser el caso, y cuando las cadenas son iguales, nunca es así. Puede o no estar teniendo este problema dependiendo de qué tan grande es su cuerpo y cuántas palabras tienen prefijos comunes.

Estaría tentado de probar una estructura de datos que está diseñada para operar con claves de secuencia, como por ejemplo el bytestring-trie sugerido amablemente por Don Stewart .