Frage Optimieren eines Haskell XML-Parsers


Ich experimentiere gerade mit Haskell und genieße die Erfahrung sehr, aber ich werte es für ein echtes Projekt mit ziemlich strengen Leistungsanforderungen aus. Der erste Durchlauf meiner Aufgabe besteht darin, einen kompletten (no-history) Dump von wikipedia (bzipped) zu verarbeiten - insgesamt etwa 6 GB komprimiert. In Python dauert ein Skript, um einen vollständigen Auszug jeder Rohseite (ungefähr 10 Millionen insgesamt) zu machen, ungefähr 30 Minuten auf meiner Box (und als Referenz benötigt eine Scala-Implementierung unter Verwendung des Pull-Parsers ungefähr 40 Minuten). Ich habe versucht, diese Leistung mit Haskell und Ghcc nachzubilden und habe darum gekämpft, dies zu erreichen.

Ich habe Codec.Compression.BZip für Dekomprimierung und Hexpat für Parsing verwendet. Ich verwende Lazy Bytestrings als Eingabe für Hexpat und Strict Bytestrings für den Elementtexttyp. Und um den Text für jede Seite zu extrahieren, baue ich eine Liste von Zeigern auf Textelemente auf und gehe dann darüber hinaus, um sie auf stdout auszugeben. Der gerade beschriebene Code hat bereits eine Reihe von Profiling / Refactor-Iterationen durchlaufen (ich bin schnell von Strings zu Bytestrings übergegangen, dann von String-Verkettungen zu Listen von Zeigern zu Text - dann zu Dlists von Zeigern zu Text). Ich denke, ich habe etwa 2 Größenordnungen Beschleunigung aus dem ursprünglichen Code, aber es dauert immer noch über anderthalb Stunden zu analysieren (obwohl es einen schönen kleinen Speicherbedarf hat). Ich bin auf der Suche nach ein bisschen Inspiration von der Community, um mir die Extrameile zu bringen. Der Code ist unten (und ich habe es in eine Reihe von Unterfunktionen aufgeteilt, um mehr Details aus dem Profiler zu erhalten). Bitte entschuldige meinen Haskell - ich habe erst seit ein paar Tagen programmiert (nachdem ich eine Woche mit Real World Haskell verbracht habe). Und danke im Voraus!

import System.Exit
import Data.Maybe
import Data.List
import Data.DList (DList)
import qualified Data.DList as DList

import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as LazyByteString
import qualified Codec.Compression.BZip as BZip

import Text.XML.Expat.Proc
import Text.XML.Expat.Tree
import Text.XML.Expat.Format

testFile = "../data/enwiki-latest-pages-articles.xml.bz2"

validPage pageData = case pageData of
    (Just _, Just _) -> True
    (_, _) -> False

scanChildren :: [UNode ByteString] -> DList ByteString
scanChildren c = case c of
    h:t -> DList.append (getContent h) (scanChildren t)
    []  -> DList.fromList []

getContent :: UNode ByteString -> DList ByteString
getContent treeElement =
    case treeElement of
        (Element name attributes children)  -> scanChildren children
        (Text text)                         -> DList.fromList [text]

rawData t = ((getContent.fromJust.fst) t, (getContent.fromJust.snd) t)

extractText page = do
    revision <- findChild (BS.pack "revision") page
    text <- findChild (BS.pack "text") revision
    return text

pageDetails tree =
    let pageNodes = filterChildren relevantChildren tree in
    let getPageData page = (findChild (BS.pack "title") page, extractText page) in
    map rawData $ filter validPage $ map getPageData pageNodes
    where
        relevantChildren node = case node of
            (Element name attributes children) -> name == (BS.pack "page")
            (Text _) -> False

outputPages pagesText = do
    let flattenedPages = map DList.toList pagesText
    mapM_ (mapM_ BS.putStr) flattenedPages

readCompressed fileName = fmap BZip.decompress (LazyByteString.readFile fileName)
parseXml byteStream = parse defaultParseOptions byteStream :: (UNode ByteString, Maybe XMLParseError)

main = do
    rawContent <- readCompressed testFile
    let (tree, mErr) = parseXml rawContent
    let pages = pageDetails tree
    let pagesText = map snd pages
    outputPages pagesText
    putStrLn "Complete!"
    exitWith ExitSuccess

7
2018-04-19 08:14


Ursprung


Antworten:


Nach dem Ausführen Ihres Programms bekomme ich etwas seltsame Ergebnisse:

./wikiparse + RTS -s -A5m -H5m | Schwanz
./wikiparse + RTS -s -A5m -H5m
3.604.204.828.592 Bytes im Heapspeicher zugewiesen
  70.746.561.168 Bytes, die während GC kopiert wurden
      39,505,112 Bytes maximaler Wohnsitz (37822 Probe (n))
       2.564.716 Bytes maximaler Slop
              83 MB Gesamtspeicher belegt (0 MB durch Fragmentierung verloren)

  Generation 0: 620343 Sammlungen, 0 parallel, 15,84s, 368,69s verstrichen
  Generation 1: 37822 Sammlungen, 0 parallel, 1,08s, 33,08s verstrichen

  INIT Zeit 0,00s (0,00s abgelaufen)
  MUT Zeit 243.85s (4003.81s verstrichen)
  GC-Zeit 16.92s (401.77s verstrichen)
  EXIT-Zeit 0,00s (0,00s verstrichen)
  Gesamtzeit 260,77s (4405,58s verstrichen)

  % GC-Zeit 6,5% (9,1% verstrichen)

  Alloc-Rate 14.780.341.336 Bytes pro MUT Sekunde

  Produktivität 93,5% des gesamten Benutzers, 5,5% der gesamten verstrichen

Gesamtzeit ist mehr als OK Ich denke: 260s ist viel schneller als 30m für Python. Ich habe keine Ahnung, warum die Gesamtzeit hier so groß ist. Ich glaube wirklich nicht, dass das Lesen von 6Gb-Dateien mehr als eine Stunde dauern würde.

Ich führe das Programm erneut aus, um zu überprüfen, ob die Ergebnisse konsistent sind.

Wenn das Ergebnis dieser 4'20 '' richtig ist, dann glaube ich, dass etwas mit der Maschine nicht stimmt ... oder es gibt hier einen anderen seltsamen Effekt.

Der Code wurde auf GHC 7.0.2 kompiliert.


Edit: Ich habe verschiedene Versionen des obigen Programms ausprobiert. Die wichtigste Optimierung scheint {- # INLINE # -} Pragma und Spezialisierung von Funktionen zu sein. Einige haben ziemlich generische Typen, von denen bekannt ist, dass sie für die Leistung schlecht sind. OTOH Ich glaube, dass Inlining genug sein sollte, um die Spezialisierung auszulösen, also sollten Sie versuchen, weiter damit zu experimentieren.

Ich habe keinen signifikanten Unterschied zwischen den Versionen von GHC gesehen, die ich ausprobiert habe (6.12 .. HEAD).

Haskell-Bindungen zu bzlib scheinen eine optimale Leistung zu haben. Das folgende Programm, das fast vollständige Neuimplementierung des Standards ist bzcat Programm, ist so schnell oder sogar schneller als das Original.

module Main where

import qualified Data.ByteString.Lazy as BSL
import qualified Codec.Compression.BZip as BZip
import System.Environment (getArgs)

readCompressed fileName = fmap (BZip.decompress) (BSL.readFile fileName)

main :: IO ()
main = do
    files <- getArgs
    mapM_ (\f -> readCompressed f >>= BSL.putStr) files                 

Auf meinem Rechner dauert es ca. 1100s, um die Testdatei zu dekomprimieren /dev/null. Die schnellste Version, die ich bekommen konnte, basierte auf dem SAX-Style-Parser. Ich bin mir jedoch nicht sicher, ob die Ausgabe mit der des Originals übereinstimmt. Bei kleinen Ausgaben ist das Ergebnis dasselbe, und ebenso die Leistung. Auf der Originaldatei ist die SAX-Version etwas schneller und schließt in ~ 2400s ab. Sie können es unten finden.

{-# LANGUAGE OverloadedStrings #-}

import System.Exit
import Data.Maybe

import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Codec.Compression.BZip as BZip

import System.IO

import Text.XML.Expat.SAX as SAX

type ByteStringL = BSL.ByteString
type Token = ByteString
type TokenParser = [SAXEvent Token Token] -> [[Token]]

testFile = "/tmp/enwiki-latest-pages-articles.xml.bz2"


readCompressed :: FilePath -> IO ByteStringL
readCompressed fileName = fmap (BZip.decompress) (BSL.readFile fileName)

{-# INLINE pageStart #-}
pageStart :: TokenParser
pageStart ((StartElement "page" _):xs) = titleStart xs
pageStart (_:xs) = pageStart xs
pageStart [] = []

{-# INLINE titleStart #-}
titleStart :: TokenParser
titleStart ((StartElement "title" _):xs) = finish "title" revisionStart xs
titleStart ((EndElement "page"):xs) = pageStart xs
titleStart (_:xs) = titleStart xs
titleStart [] = error "could not find <title>"


{-# INLINE revisionStart #-}
revisionStart :: TokenParser
revisionStart ((StartElement "revision" _):xs) = textStart xs
revisionStart ((EndElement "page"):xs) = pageStart xs
revisionStart (_:xs) = revisionStart xs
revisionStart [] = error "could not find <revision>"

{-# INLINE textStart #-}
textStart :: TokenParser
textStart ((StartElement "text" _):xs) = textNode [] xs
textStart ((EndElement "page"):xs) = pageStart xs
textStart (_:xs) = textStart xs
textStart [] = error "could not find <text>"

{-# INLINE textNode #-}
textNode :: [Token] -> TokenParser
textNode acc ((CharacterData txt):xs) = textNode (txt:acc) xs
textNode acc xs = (reverse acc) : textEnd xs

{-# INLINE textEnd #-}
textEnd {- , revisionEnd, pageEnd -} :: TokenParser
textEnd = finish "text" . finish "revision" . finish "page" $ pageStart
--revisionEnd = finish "revision" pageEnd
--pageEnd = finish "page" pageStart

{-# INLINE finish #-}
finish :: Token -> TokenParser -> TokenParser
finish tag cont ((EndElement el):xs) | el == tag = cont xs
finish tag cont (_:xs) = finish tag cont xs
finish tag _ [] = error (show (tag,("finish []" :: String)))

main :: IO ()
main = do
  rawContent <- readCompressed testFile
  let parsed = (pageStart (SAX.parse defaultParseOptions rawContent))
  mapM_ (mapM_ BS.putStr) ({- take 5000 -} parsed) -- remove comment to finish early
  putStrLn "Complete!"

Generell bin ich misstrauisch, dass Pythons und Scalas Versionen früh fertig sind. Ich konnte diesen Anspruch jedoch ohne den Quellcode nicht überprüfen.

Zusammenfassend: Inlining und Spezialisierung sollten eine sinnvolle, etwa zweifache Steigerung der Performance ermöglichen.


5
2018-04-19 15:07