Warum läuft dieser Haskell-Code mit -O langsamer?

Dieser Teil des Haskell-Codes läuft mit aber viel langsamer-O-O sollte aber ungefährlich sein . Kann mir jemand sagen, was passiert ist? Wenn es darauf ankommt, ist es ein Versuch, dieses Problem zu lösen , und es verwendet die binäre Suche und den persistenten Segmentbaum:

import Control.Monad
import Data.Array

data Node =
      Leaf   Int           -- value
    | Branch Int Node Node -- sum, left child, right child
type NodeArray = Array Int Node

-- create an empty node with range [l, r)
create :: Int -> Int -> Node
create l r
    | l + 1 == r = Leaf 0
    | otherwise  = Branch 0 (create l m) (create m r)
    where m = (l + r) `div` 2

-- Get the sum in range [0, r). The range of the node is [nl, nr)
sumof :: Node -> Int -> Int -> Int -> Int
sumof (Leaf val) r nl nr
    | nr <= r   = val
    | otherwise = 0
sumof (Branch sum lc rc) r nl nr
    | nr <= r   = sum
    | r  > nl   = (sumof lc r nl m) + (sumof rc r m nr)
    | otherwise = 0
    where m = (nl + nr) `div` 2

-- Increase the value at x by 1. The range of the node is [nl, nr)
increase :: Node -> Int -> Int -> Int -> Node
increase (Leaf val) x nl nr = Leaf (val + 1)
increase (Branch sum lc rc) x nl nr
    | x < m     = Branch (sum + 1) (increase lc x nl m) rc
    | otherwise = Branch (sum + 1) lc (increase rc x m nr)
    where m = (nl + nr) `div` 2

-- signature said it all
tonodes :: Int -> [Int] -> [Node]
tonodes n = reverse . tonodes' . reverse
    where
        tonodes' :: [Int] -> [Node]
        tonodes' (h:t) = increase h' h 0 n : s' where s'@(h':_) = tonodes' t
        tonodes' _ = [create 0 n]

-- find the minimum m in [l, r] such that (predicate m) is True
binarysearch :: (Int -> Bool) -> Int -> Int -> Int
binarysearch predicate l r
    | l == r      = r
    | predicate m = binarysearch predicate l m
    | otherwise   = binarysearch predicate (m+1) r
    where m = (l + r) `div` 2

-- main, literally
main :: IO ()
main = do
    [n, m] <- fmap (map read . words) getLine
    nodes <- fmap (listArray (0, n) . tonodes n . map (subtract 1) . map read . words) getLine
    replicateM_ m $ query n nodes
    where
        query :: Int -> NodeArray -> IO ()
        query n nodes = do
            [p, k] <- fmap (map read . words) getLine
            print $ binarysearch (ok nodes n p k) 0 n
            where
                ok :: NodeArray -> Int -> Int -> Int -> Int -> Bool
                ok nodes n p k s = (sumof (nodes ! min (p + s + 1) n) s 0 n) - (sumof (nodes ! max (p - s) 0) s 0 n) >= k

(Dies ist genau der gleiche Code wie bei der Codeüberprüfung, aber diese Frage behebt ein anderes Problem.)

Dies ist mein Eingabegenerator in C ++:

#include <cstdio>
#include <cstdlib>
using namespace std;
int main (int argc, char * argv[]) {
    srand(1827);
    int n = 100000;
    if(argc > 1)
        sscanf(argv[1], "%d", &n);
    printf("%d %d\n", n, n);
    for(int i = 0; i < n; i++)
        printf("%d%c", rand() % n + 1, i == n - 1 ? '\n' : ' ');
    for(int i = 0; i < n; i++) {
        int p = rand() % n;
        int k = rand() % n + 1;
        printf("%d %d\n", p, k);
    }
}

Falls Sie keinen C ++ - Compiler zur Verfügung haben, dies das Ergebnis von./gen.exe 1000 .

Dies ist das Ausführungsergebnis auf meinem Computer:

$ ghc --version
The Glorious Glasgow Haskell Compilation System, version 7.8.3
$ ghc -fforce-recomp 1827.hs
[1 of 1] Compiling Main             ( 1827.hs, 1827.o )
Linking 1827.exe ...
$ time ./gen.exe 1000 | ./1827.exe > /dev/null
real    0m0.088s
user    0m0.015s
sys     0m0.015s
$ ghc -fforce-recomp -O 1827.hs
[1 of 1] Compiling Main             ( 1827.hs, 1827.o )
Linking 1827.exe ...
$ time ./gen.exe 1000 | ./1827.exe > /dev/null
real    0m2.969s
user    0m0.000s
sys     0m0.045s

Und dies ist die Zusammenfassung des Heap-Profils:

$ ghc -fforce-recomp -rtsopts ./1827.hs
[1 of 1] Compiling Main             ( 1827.hs, 1827.o )
Linking 1827.exe ...
$ ./gen.exe 1000 | ./1827.exe +RTS -s > /dev/null
      70,207,096 bytes allocated in the heap
       2,112,416 bytes copied during GC
         613,368 bytes maximum residency (3 sample(s))
          28,816 bytes maximum slop
               3 MB total memory in use (0 MB lost due to fragmentation)
                                    Tot time (elapsed)  Avg pause  Max pause
  Gen  0       132 colls,     0 par    0.00s    0.00s     0.0000s    0.0004s
  Gen  1         3 colls,     0 par    0.00s    0.00s     0.0006s    0.0010s
  INIT    time    0.00s  (  0.00s elapsed)
  MUT     time    0.03s  (  0.03s elapsed)
  GC      time    0.00s  (  0.01s elapsed)
  EXIT    time    0.00s  (  0.00s elapsed)
  Total   time    0.03s  (  0.04s elapsed)
  %GC     time       0.0%  (14.7% elapsed)
  Alloc rate    2,250,213,011 bytes per MUT second
  Productivity 100.0% of total user, 83.1% of total elapsed
$ ghc -fforce-recomp -O -rtsopts ./1827.hs
[1 of 1] Compiling Main             ( 1827.hs, 1827.o )
Linking 1827.exe ...
$ ./gen.exe 1000 | ./1827.exe +RTS -s > /dev/null
   6,009,233,608 bytes allocated in the heap
     622,682,200 bytes copied during GC
         443,240 bytes maximum residency (505 sample(s))
          48,256 bytes maximum slop
               3 MB total memory in use (0 MB lost due to fragmentation)
                                    Tot time (elapsed)  Avg pause  Max pause
  Gen  0     10945 colls,     0 par    0.72s    0.63s     0.0001s    0.0004s
  Gen  1       505 colls,     0 par    0.16s    0.13s     0.0003s    0.0005s
  INIT    time    0.00s  (  0.00s elapsed)
  MUT     time    2.00s  (  2.13s elapsed)
  GC      time    0.87s  (  0.76s elapsed)
  EXIT    time    0.00s  (  0.00s elapsed)
  Total   time    2.89s  (  2.90s elapsed)
  %GC     time      30.3%  (26.4% elapsed)
  Alloc rate    3,009,412,603 bytes per MUT second
  Productivity  69.7% of total user, 69.4% of total elapsed

Ich denke, es ist Zeit, dass diese Frage eine richtige Antwort bekommt.

Was ist mit deinem Code passiert? -O

Lassen Sie mich Ihre Hauptfunktion vergrößern und leicht umschreiben:

main :: IO ()
main = do
    [n, m] <- fmap (map read . words) getLine
    line <- getLine
    let nodes = listArray (0, n) . tonodes n . map (subtract 1) . map read . words $ line
    replicateM_ m $ query n nodes

Die Absicht hier ist eindeutig, dass das NodeArrayeinmal erstellt und dann in jeder der mAufrufe von verwendet wird query.

Leider wandelt GHC diesen Code effektiv in effektiv um

main = do
    [n, m] <- fmap (map read . words) getLine
    line <- getLine
    replicateM_ m $ do
        let nodes = listArray (0, n) . tonodes n . map (subtract 1) . map read . words $ line
        query n nodes

und Sie können das Problem sofort hier sehen.

Was ist der State Hack und warum zerstört er die Leistung meines Programms?

Der Grund ist der State Hack, der (grob) sagt: "Wenn etwas vom Typ ist IO a, nehmen Sie an, dass es nur einmal aufgerufen wird." Die offizielle Dokumentation ist nicht viel ausführlicher:

-fno-state-hack

Deaktivieren Sie den "State Hack", bei dem jedes Lambda mit einem State # -Token als Argument als Einzeleintrag betrachtet wird. Daher wird es als OK angesehen, darin enthaltene Elemente zu integrieren. Dies kann die Leistung von E / A- und ST-Monadencode verbessern, birgt jedoch das Risiko, die Freigabe zu verringern.

Die Idee lautet ungefähr wie folgt: Wenn Sie eine Funktion mit einem IOTyp und einer where-Klausel definieren, z

foo x = do
    putStrLn y
    putStrLn y
  where y = ...x...

Etwas vom Typ IO akann als etwas vom Typ angesehen werden RealWord -> (a, RealWorld). In dieser Ansicht wird das Obige (ungefähr)

foo x = 
   let y = ...x... in 
   \world1 ->
     let (world2, ()) = putStrLn y world1
     let (world3, ()) = putStrLn y world2
     in  (world3, ())

Ein Anruf bei foowürde (normalerweise) so aussehen foo argument world. Aber die Definition von foonimmt nur ein Argument an, und das andere wird erst später von einem lokalen Lambda-Ausdruck verbraucht! Das wird ein sehr langsamer Anruf sein foo. Es wäre viel schneller, wenn der Code so aussehen würde:

foo x world1 = 
   let y = ...x... in 
   let (world2, ()) = putStrLn y world1
   let (world3, ()) = putStrLn y world2
   in  (world3, ())

Dies wird als Eta-Erweiterung bezeichnet und erfolgt aus verschiedenen Gründen (z. B. durch Analyse der Funktionsdefinition , Überprüfung des Aufrufs und - in diesem Fall - typgerichtete Heuristik).

Leider verschlechtert dies die Leistung, wenn der Aufruf von footatsächlich die Form hat let fooArgument = foo argument, dh mit einem Argument, das jedoch world(noch) nicht bestanden wurde. Wenn der ursprüngliche Code fooArgumentdann mehrmals verwendet wird, ywird er immer noch nur einmal berechnet und gemeinsam genutzt. Im geänderten Codey wird jedes Mal neu berechnet - genau das, was mit Ihrem passiert istnodes .

Können Dinge repariert werden?

Möglicherweise. Siehe # 9388 für einen Versuch, dies zu tun. Das Problem bei der Behebung besteht darin, dass die Leistung in vielen Fällen, in denen die Umwandlung in Ordnung ist, Kosten verursacht, obwohl der Compiler dies möglicherweise nicht sicher wissen kann. Und es gibt wahrscheinlich Fälle, in denen es technisch nicht in Ordnung ist, dh das Teilen geht verloren, aber es ist immer noch vorteilhaft, weil die Beschleunigungen durch das schnellere Anrufen die zusätzlichen Kosten der Neuberechnung überwiegen. Es ist also nicht klar, wohin man von hier aus gehen soll.