Eine Histogrammberechnung in Haskell schneller machen

Question

Ich bin zu Haskell ziemlich neu und ich möchte ein Histogramm erstellen. Ich verwende Data.Vector.Unboxed, um Vorgänge an den Daten zu fusionieren; welches blitzschnell ist (wenn es mit -O -fllvm kompiliert wird) und der Flaschenhals ist meine Fallapplikation; was die Bucket-Zählungen aggregiert.

Wie kann ich es schneller machen? Ich habe gelesen, dass ich versucht habe, die Anzahl der Thunks zu reduzieren, indem ich die Dinge strikt halte, also habe ich die Dinge strikt gemacht, indem ich seq und foldr benutze, aber nicht viel Leistungssteigerung sehe. Ihre Ideen werden dringend empfohlen.

import qualified Data.Vector.Unboxed as V 

histogram :: [(Int,Int)] 
histogram = V.foldr' agg [] $ V.zip k v 
where 
    n = 10000000 
    c = 1000000 
    k = V.generate n (\i -> i `div` c * c) 
    v = V.generate n (\i -> 1) 
    agg kv [] = [kv] 
    agg kv@(k,v) acc@((ck,cv):as) 
     | k == ck = let a = (ck,cv+v):as in a `seq` a 
     | otherwise = let a = kv:acc in a `seq` a 

main :: IO() 
main = print histogram 

Zusammengestellt mit:

ghc --make -O -fllvm histogram.hs 

Answer 1

Zuerst kompilieren das Programm mit -O2 -rtsopts. Dann erhalten eine erste Idee, wo Sie könnten optimieren, führen Sie das Programm mit den Optionen +RTS -sstderr:

$ ./question +RTS -sstderr 
[(0,1000000),(1000000,1000000),(2000000,1000000),(3000000,1000000),(4000000,1000000),(5000000,1000000),(6000000,1000000),(7000000,1000000),(8000000,1000000),(9000000,1000000)] 
    1,193,907,224 bytes allocated in the heap 
    1,078,027,784 bytes copied during GC 
    282,023,968 bytes maximum residency (7 sample(s)) 
     86,755,184 bytes maximum slop 
      763 MB total memory in use (0 MB lost due to fragmentation) 

            Tot time (elapsed) Avg pause Max pause 
    Gen 0  1964 colls,  0 par 3.99s 4.05s  0.0021s 0.0116s 
    Gen 1   7 colls,  0 par 1.60s 1.68s  0.2399s 0.6665s 

    INIT time 0.00s ( 0.00s elapsed) 
    MUT  time 2.67s ( 2.68s elapsed) 
    GC  time 5.59s ( 5.73s elapsed) 
    EXIT time 0.02s ( 0.03s elapsed) 
    Total time 8.29s ( 8.43s elapsed) 

    %GC  time  67.4% (67.9% elapsed) 

    Alloc rate 446,869,876 bytes per MUT second 

    Productivity 32.6% of total user, 32.0% of total elapsed 

Beachten Sie, dass 67% Ihrer Zeit in GC ausgegeben wird! Da ist eindeutig etwas nicht in Ordnung. Um herauszufinden, was falsch ist, können wir das Programm mit Heap-Profilerstellung aktiviert laufen (mit +RTS -h), die der folgenden Abbildung erzeugt:

Also, Sie undichte Thunks. Wie kommt es dazu? Betrachtet man den Code, ist der einzige Zeitpunkt, an dem ein Thunk (rekursiv) in agg aufgebaut wird, der, wenn du die Addition machst. somit wird das Problem behoben zu machen cv streng durch einen Knall Muster fügt hinzu:

{-# LANGUAGE BangPatterns #-} 
import qualified Data.Vector.Unboxed as V 

histogram :: [(Int,Int)] 
histogram = V.foldr' agg [] $ V.zip k v 
where 
    n = 10000000 
    c = 1000000 
    k = V.generate n (\i -> i `div` c * c) 
    v = V.generate n id 
    agg kv [] = [kv] 
    agg kv@(k,v) acc@((ck,!cv):as) -- Note the ! 
     | k == ck = (ck,cv+v):as 
     | otherwise = kv:acc 

main :: IO() 
main = print histogram 

Ausgang:

$ time ./improved +RTS -sstderr 
[(0,499999500000),(1000000,1499999500000),(2000000,2499999500000),(3000000,3499999500000),(4000000,4499999500000),(5000000,5499999500000),(6000000,6499999500000),(7000000,7499999500000),(8000000,8499999500000),(9000000,9499999500000)] 
    672,063,056 bytes allocated in the heap 
      94,664 bytes copied during GC 
    160,028,816 bytes maximum residency (2 sample(s)) 
     1,464,176 bytes maximum slop 
      155 MB total memory in use (0 MB lost due to fragmentation) 

            Tot time (elapsed) Avg pause Max pause 
    Gen 0  992 colls,  0 par 0.03s 0.03s  0.0000s 0.0001s 
    Gen 1   2 colls,  0 par 0.03s 0.03s  0.0161s 0.0319s 

    INIT time 0.00s ( 0.00s elapsed) 
    MUT  time 1.24s ( 1.25s elapsed) 
    GC  time 0.06s ( 0.06s elapsed) 
    EXIT time 0.03s ( 0.03s elapsed) 
    Total time 1.34s ( 1.34s elapsed) 

    %GC  time  4.4% (4.5% elapsed) 

    Alloc rate 540,674,868 bytes per MUT second 

    Productivity 95.5% of total user, 95.1% of total elapsed 

./improved +RTS -sstderr 1,14s user 0,20s system 99% cpu 1,352 total 

Das ist viel besser.

---

So, jetzt könnte man fragen, warum die Frage erscheinen, obwohl Sie seq verwendet? Der Grund dafür ist die seq nur erzwingt das erste Argument zu WHNF, und für ein Paar, (_,_) (wo sind unbewertete Thunks) ist bereits WHNF! Auch ist seq a a die gleiche wie a, weil es seq a b (informell) bedeutet: bewerten a vor b ausgewertet, so seq a a nur bedeutet: bewerten ein, bevor a ausgewertet, und das ist das gleiche wie nur eine Bewertung!