Potongan kode Haskell ini berjalan jauh lebih lambat -O
, tetapi -O
seharusnya tidak berbahaya . Adakah yang bisa memberi tahu saya apa yang terjadi? Jika penting, ini merupakan upaya untuk memecahkan 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 adalah kode yang sama persis dengan tinjauan 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
.
Berikut 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 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
haskell
optimization
ghc
compiler-bug
johnchen902
sumber
sumber
-fno-state-hack
. Maka saya harus benar-benar mencoba melihat detailnya.IO
atauST
tipe) dipanggil hanya sekali. Biasanya tebakan yang bagus, tetapi jika tebakannya salah, GHC dapat menghasilkan kode yang sangat buruk. Para pengembang telah mencoba menemukan cara untuk mendapatkan yang baik tanpa yang buruk untuk waktu yang cukup lama. Saya pikir Joachim Breitner sedang mengerjakannya hari ini.replicateM_
, dan di sana GHC akan salah memindahkan komputasi dari luarreplicateM_
ke dalam, sehingga mengulanginya.Jawaban:
Saya kira sudah saatnya pertanyaan ini mendapat jawaban yang tepat.
Apa yang terjadi dengan kode Anda
-O
Izinkan saya memperbesar fungsi utama Anda, dan menulis 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
itu dibuat sekali, dan kemudian digunakan dalam setiapm
pemanggilanquery
.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 bisa langsung melihat masalahnya di sini.
Apa yang dimaksud dengan peretasan negara, dan mengapa hal itu merusak kinerja program saya
Alasannya adalah peretasan negara, yang mengatakan (secara kasar): "Ketika sesuatu memiliki tipe
IO a
, anggap itu dipanggil hanya sekali.". The dokumentasi resmi tidak jauh lebih rumit:Secara kasar, idenya adalah sebagai berikut: Jika Anda mendefinisikan fungsi dengan
IO
klausa type dan where, misalnyafoo x = do putStrLn y putStrLn y where y = ...x...
Sesuatu dari tipe
IO a
dapat dipandang sebagai sesuatu yang bertipeRealWord -> (a, RealWorld)
. Dalam pandangan itu, di atas menjadi (secara kasar)foo x = let y = ...x... in \world1 -> let (world2, ()) = putStrLn y world1 let (world3, ()) = putStrLn y world2 in (world3, ())
Panggilan ke
foo
(biasanya) akan terlihat seperti inifoo argument world
. Tetapi definisifoo
hanya membutuhkan satu argumen, dan yang lainnya hanya dikonsumsi kemudian oleh ekspresi lambda lokal! Itu akan menjadi panggilan yang sangat lambatfoo
. Akan jauh lebih cepat jika kodenya terlihat seperti ini:foo x world1 = let y = ...x... in let (world2, ()) = putStrLn y world1 let (world3, ()) = putStrLn y world2 in (world3, ())
Ini disebut ekspansi eta dan dilakukan dengan berbagai alasan (misalnya dengan menganalisis definisi fungsi , dengan memeriksa bagaimana dipanggil , dan - dalam hal ini - heuristik terarah tipe).
Sayangnya, ini menurunkan kinerja jika panggilan ke
foo
sebenarnya dalam bentuklet fooArgument = foo argument
, yaitu dengan argumen, tetapi tidakworld
lulus (belum). Dalam kode aslinya, jikafooArgument
kemudian digunakan beberapa kali,y
tetap akan dihitung hanya sekali, dan dibagikan. Dalam kode yang dimodifikasi,y
akan dihitung ulang setiap saat - tepatnya apa yang terjadi pada Andanodes
.Bisakah hal-hal diperbaiki?
Mungkin. Lihat # 9388 untuk mencoba melakukannya. Masalah dengan memperbaikinya adalah bahwa ini akan membebani kinerja dalam banyak kasus di mana transformasi terjadi dengan baik, meskipun kompiler tidak mungkin mengetahui hal itu dengan pasti. Dan mungkin ada kasus di mana secara teknis tidak baik, yaitu berbagi hilang, tetapi masih bermanfaat karena percepatan dari panggilan yang lebih cepat lebih besar daripada biaya tambahan penghitungan ulang. Jadi tidak jelas kemana harus pergi dari sini.
sumber
foo
"?-f-no-state-hack
saat menyusun tampaknya bobot yang cukup berat.{-# NOINLINE #-}
sepertinya hal yang jelas tetapi saya tidak dapat memikirkan bagaimana menerapkannya di sini. Mungkin cukup hanya dengan membuatnodes
tindakan IO dan mengandalkan urutan>>=
?replicateM_ n foo
denganforM_ (\_ -> foo) [1..n]
bantuan.