Warum ist dieses einfache Textanalyseprogramm so langsam?

Question

Dies ist mein Code für Zeilen und Wörter zählen:

import System.IO 
import Data.List 
main = do 
     hSetBinaryMode stdin True 
     interact $ (\(w,l)->"line:"++(show l)++"\nwords:"++(show w)++"\n") 
        . foldl' (\(w,l) r-> w `seq` l `seq` (w+length r ,succ l)) (0,0) 
        . lines 

Dieser Vorgang dauert etwa 10 Sekunden auf eine Datei von etwa 100 Megabyte laufen. Ich habe es mit ähnlichen Programmen in Lua (9s), awk (20s) und wc -l -c (0.6s) verglichen.

Warum ist dieser Code so langsam? Was könnte das Problem sein?

Answer 1

I/O mit String ist bekanntermaßen weniger als schnell in Haskell. Die vom Handle gelesenen Bytes müssen im Allgemeinen in Unicode-Codepunkte konvertiert werden, und dann wird daraus eine verkettete Liste erstellt. Das ist eine Menge Arbeit, die viel Zuteilung verursacht. In diesem Fall ist die Umwandlung in Codepunkte etwas einfacher, da Sie stdin in den binären Modus setzen, aber die Konstruktion der verketteten Liste von Zeichen nimmt immer noch eine Menge Zeit in Anspruch.

Ein weiterer kleiner Faktor ist, dass Ihre Zeilenanzahl Integer verwendet, aber das ist geringfügig und spielt nur eine wichtige Rolle, wenn die I/O auf Hochtouren ist.

Wenn Sie schnelle E/A benötigen, müssen Sie einen Typ verwenden, der besser dafür geeignet ist. Eine Möglichkeit ist mit ByteString, zum Beispiel

import Data.List 
import qualified Data.ByteString.Lazy.Char8 as C 
main = do 
     txt <- C.getContents 
     putStrLn $ (\(w,l)->"line:"++(show l)++"\nwords:"++(show w)++"\n"). foldl' (\(w,l) r-> w `seq` l `seq` (w+C.length r ,succ l)) (0,0) . C.lines $ txt 

macht den Job auf einer 94MB-Datei in 0.12s auf meiner Box (wc -l -c nimmt 0.06s), während das Original mit String 4.4s nahm. Es kann weiter optimiert werden,

{-# LANGUAGE BangPatterns #-} 
import Data.List 
import qualified Data.ByteString.Lazy.Char8 as C 
main = do 
     txt <- C.getContents 
     putStrLn $ (\(w,l)->"line:"++(show l)++"\nwords:"++(show w)++"\n"). loop 0 0 . C.lines $ txt 

loop :: Int -> Int -> [C.ByteString] -> (Int,Int) 
loop !w !l (ln:lns) = loop (w + fromIntegral (C.length ln)) (l+1) lns 
loop w l _ = (w,l) 

nur 0.08s nimmt, was anständig genug ist für mich dort zu optimieren zu stoppen (für die String Version eine ähnliche Änderung bringt die Zeit bis zu 3.6s dafür).