Pertanyaan Mengapa kode Haskell ini berjalan lebih lambat dengan -O?


Potongan kode Haskell ini berjalan banyak lebih lambat dengan -O, tapi -O seharusnya tidak berbahaya. Adakah yang bisa memberitahuku apa yang terjadi? Jika itu penting, ini adalah upaya untuk dipecahkan masalah ini, dan menggunakan pencarian biner dan pohon segmen persisten:

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

(Ini persis sama dengan kode ulasan kode tetapi pertanyaan ini membahas masalah lain.)

Ini adalah generator input saya di 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);
    }
}

Jika Anda tidak memiliki kompiler C ++ yang tersedia, ini adalah hasil dari ./gen.exe 1000.

Ini adalah hasil eksekusi di komputer saya:

$ 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

Dan ini adalah ringkasan profil heap:

$ 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

85
2018-04-02 02:29


asal


Jawaban:


Saya kira sudah waktunya pertanyaan ini mendapat jawaban yang tepat.

Apa yang terjadi dengan kode Anda -O

Biarkan saya memperbesar fungsi utama Anda, dan tulis ulang sedikit:

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

Jelas, maksudnya di sini adalah bahwa NodeArray dibuat satu kali, dan kemudian digunakan di setiap m panggilan dari query.

Sayangnya, GHC mengubah kode ini menjadi, secara efektif,

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

dan Anda dapat langsung melihat masalahnya di sini.

Apa yang diretas oleh negara, dan mengapa itu menghancurkan kinerja program saya

Alasannya adalah hack negara, yang mengatakan (kira-kira): “Ketika ada sesuatu yang tipenya IO a, anggap itu hanya dipanggil sekali. ". Itu dokumentasi resmi tidak lebih rumit:

-fno-state-hack

Matikan "hack keadaan" di mana setiap lambda dengan token Negara sebagai argumen dianggap sebagai single-entry, maka itu dianggap OK untuk menyatukan hal-hal di dalamnya. Ini dapat meningkatkan kinerja kode IO dan ST monad, tetapi menjalankan risiko mengurangi pembagian.

Kira-kira, idenya adalah sebagai berikut: Jika Anda mendefinisikan fungsi dengan IO ketik dan di mana klausa, mis.

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

Sesuatu yang tipikal IO a dapat dilihat sebagai sesuatu yang tipenya RealWord -> (a, RealWorld). Dalam pandangan itu, hal di atas menjadi (kira-kira)

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

Panggilan ke foo akan (biasanya) terlihat seperti ini foo argument world. Namun definisi foo hanya mengambil satu argumen, dan yang lainnya hanya dikonsumsi kemudian oleh ekspresi lambda lokal! Itu akan menjadi panggilan yang sangat lambat untuk foo. Akan lebih cepat jika kode akan terlihat seperti ini:

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

Ini disebut eta-ekspansi dan dilakukan pada berbagai alasan (misalnya oleh menganalisa definisi fungsi, oleh memeriksa bagaimana itu dipanggil, dan - dalam hal ini - tipe heuristik yang diarahkan).

Sayangnya itu tidak sehat jika panggilan ke foo sebenarnya dari bentuk let fooArgument = foo argument, yaitu dengan argumen, tetapi tidak world lulus (belum). Dalam kode asli, jika fooArgument kemudian digunakan beberapa kali, y akan tetap dihitung hanya sekali, dan dibagikan. Dalam kode yang dimodifikasi, y akan dihitung ulang setiap kali - tepatnya apa yang terjadi pada Anda nodes.

Bisakah semuanya diperbaiki?

Mungkin. Lihat # 9388 untuk upaya melakukannya. Masalah dengan memperbaikinya adalah itu akankinerja biaya dalam banyak kasus di mana transformasi terjadi ok, meskipun compiler tidak mungkin tahu pasti. Dan mungkin ada kasus-kasus di mana secara teknis tidak ok, yaitu berbagi hilang, tetapi masih menguntungkan karena percepatan dari panggilan yang lebih cepat melebihi biaya tambahan penghitungan ulang. Jadi tidak jelas ke mana harus pergi dari sini.


39
2018-06-02 17:58