Bu Haskell kodu neden -O ile daha yavaş çalışıyor?

Bu Haskell kodu parçası ile çok daha yavaş çalışır -O, ancak tehlikeli-O olmamalıdır . Biri bana ne olduğunu söyleyebilir mi? Önemliyse, bu sorunu çözme girişimidir ve ikili arama ve kalıcı bölüm ağacı kullanır:

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

(Bu, kod incelemesiyle tamamen aynı koddur, ancak bu soru başka bir soruna yöneliktir.)

Bu benim C ++ 'daki girdi oluşturucum

#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);
    }
}

Kullanılabilir bir C ++ derleyiciniz yoksa, bu./gen.exe 1000 .

Bu, bilgisayarımdaki yürütme sonucu:

$ 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

Ve bu, yığın profili özetidir:

$ 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

Sanırım bu sorunun doğru bir cevap almasının zamanı geldi.

İle kodunuza ne oldu -O

Ana işlevinizi yakınlaştırmama ve biraz yeniden yazmama izin verin:

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

Açıkçası, buradaki niyet, bir NodeArraykez yaratılması ve daha sonra her mçağrıda kullanılmasıdır.query .

Maalesef, GHC bu kodu etkili bir şekilde

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

ve sorunu hemen buradan görebilirsiniz.

Durum hack nedir ve program performansımı neden bozar?

Sebep, (kabaca) şunu söyleyen devlet saldırısıdır: "Bir şey tip olduğunda IO a, sadece bir kez çağrıldığını varsayalım.". Resmi belgeler çok daha ayrıntılı değildir:

-fno-state-hack

Bağımsız değişken olarak State # belirtecine sahip herhangi bir lambda'nın tek girişli olduğu düşünülen "durum hack" i kapatın, bu nedenle içindeki şeyleri satır içi yapmakta sorun yok. Bu, IO ve ST monad kodunun performansını artırabilir, ancak paylaşımı azaltma riskini taşır.

Kabaca fikir şu şekildedir: Bir IOtür ve bir where cümlesiyle bir işlev tanımlarsanız , örneğin

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

Tipik bir şey, tipte bir şey IO aolarak görülebilir RealWord -> (a, RealWorld). Bu görüşe göre, yukarıdakiler (kabaca)

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

Bir çağrı foo(tipik olarak) böyle görünür foo argument world. Ancak tanımı fooyalnızca bir argüman alır ve diğeri ancak daha sonra yerel bir lambda ifadesi tarafından tüketilir! Bu çok yavaş bir çağrı olacak foo. Kod şöyle görünseydi çok daha hızlı olurdu:

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

Bu eta-genişleme denilen ve çeşitli gerekçelerle yapılan (örneğin tarafından olduğu işlevin tanımını analiz yoluyla, o çağrılan nasıl kontrol ve - bu durumda - tip yönettiği sezgisel tarama).

Maalesef, bu, çağrısı foogerçekten formdaysa let fooArgument = foo argument, yani bir argümanla, ancak worldgeçmemişse (henüz) performansı düşürür . Orijinal kodda, fooArgumentdaha sonra birkaç kez kullanılırsa, yyine de yalnızca bir kez hesaplanacak ve paylaşılacaktır. Değiştirilen kodda, yher seferinde yeniden hesaplanacak - tam olarak size ne olduğunodes .

Bir şeyler düzeltilebilir mi?

Muhtemelen. Bunu yapma girişimi için # 9388'e bakın . Sabitleme ile sorun tam o olacak derleyici muhtemelen Bundan emin olamaz rağmen dönüşüm OK olur durumlarda bir çok performans mal oldu. Ve muhtemelen teknik olarak uygun olmadığı durumlar vardır, yani paylaşım kaybolur, ancak yine de faydalıdır çünkü daha hızlı aramadan kaynaklanan hız artışları, yeniden hesaplamanın ekstra maliyetinden ağır basar. Yani buradan nereye gideceğim belli değil.