Optimisation du code Haskell

Question

J'essaie d'apprendre Haskell et après un article dans reddit sur les chaînes de texte Markov, j'ai décidé d'implémenter la génération de texte Markov d'abord en Python et maintenant dans Haskell. Cependant, j'ai remarqué que mon implémentation de Python est bien plus rapide que la version de Haskell, même Haskell est compilé en code natif. Je me demande ce que je devrais faire pour accélérer le code Haskell et pour l'instant je crois que c'est beaucoup plus lent à cause de l'utilisation de Data.Map au lieu de hashmaps, mais je ne suis pas sûr. et Haskell aussi. Avec les mêmes données, Python prend environ 3 secondes et Haskell est plus proche de 16 secondes.

Il va sans dire que je vais prendre toute critique constructive :).

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

J'ai essayé d'éviter de faire quelque chose de fantaisie ou de subtile. Ce ne sont que deux approches pour faire le groupement; le premier met l'accent sur l'appariement des motifs, le second ne le fait pas.

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" 

Je pense qu'ils sont à la fois plus rapide que la version originale, mais il est vrai que je ne les ai essayés contre le premier corpus raisonnable j'ai trouvé.

EDIT Comme par point très valide 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 2

a) Comment compilez-vous? (ghc -O2?)

b) Quelle version de GHC?

c) Data.Map est assez efficace, mais vous pouvez être trompé dans les mises à jour paresseuses - utilisez insertWith ', pas insertWithKey.

d) Ne pas convertir les chaînes par octets en chaîne. Gardez-les comme bytestrings, et stockez-les dans la Map

Answer 3

Comme Don l'a suggéré, regardez dans l'utilisation des versions plus strictes de vos fonctions: insertWithKey '(et M.insertWith' puisque vous ignorez le param de la clé la deuxième fois de toute façon).

Il semble que votre code génère probablement beaucoup de thunk jusqu'à ce qu'il atteigne la fin de votre [String].

Départ: http://book.realworldhaskell.org/read/profiling-and-optimization.html

... essayez surtout le tas graphiquement (à mi-chemin du chapitre). Intéressé de voir ce que vous comprendre.

Answer 4

1) Je ne comprends pas clairement votre code. a) Vous définissez "renard" mais ne l'utilisez pas. Est-ce que vous vouliez nous aider à utiliser "fox" au lieu de lire le fichier? b) Vous déclarez ceci comme "module Markov" puis avez une "main" dans le module. c) System.Random n'est pas nécessaire. Cela nous aide à vous aider si vous nettoyez un peu le code avant de poster.

2) Utilisez ByteStrings et certaines opérations strictes comme Don l'a dit.

3) Compilez avec -O2 et utilisez -fforce-recomp pour vous assurer que vous avez réellement recompilé le code.

4) Essayez cette légère transformation, cela fonctionne très rapidement (0,005 secondes). Évidemment, l'entrée est ridiculement petite, vous devez donc fournir votre fichier ou simplement le tester vous-même.

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

Voici une foldl' la version à base qui semble être deux fois plus vite que votre 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) 

Je l'ai essayé sur le projet Gutenberg Huckleberry Finn (que je suppose est votre 76.txt), et il produit la même sortie que votre fonction. Ma comparaison de temps était très peu scientifique, mais cette approche vaut probablement un coup d'oeil.

Answer 6

Data.Map est conçu dans l'hypothèse que les comparaisons de classe Ord prennent un temps constant. Pour les clés de chaîne, cela peut ne pas être le cas — et lorsque les chaînes sont égales, ce n'est jamais le cas. Vous pouvez ou ne pouvez pas toucher ce problème en fonction de la taille de votre corpus et du nombre de mots ayant des préfixes communs.

Je serais tenté d'essayer une structure de données conçue pour fonctionner avec des clés de séquence, comme par exemple le paquet bytestring-trie suggéré par Don Stewart.