Этот фрагмент кода Haskell работает намного медленнее -O
, но не -O
должен быть опасным . Кто-нибудь может сказать мне, что случилось? Если это важно, то это попытка решить эту проблему , и она использует двоичный поиск и постоянное дерево сегментов:
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
(Это точно такой же код с обзором кода, но этот вопрос решает другую проблему.)
Это мой генератор ввода на 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);
}
}
Если у вас нет компилятора C ++, это результат./gen.exe 1000
.
Это результат выполнения на моем компьютере:
$ 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
И это сводка профиля кучи:
$ 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
источник
источник
-fno-state-hack
. Тогда мне придется действительно попытаться изучить детали.IO
илиST
), вызываются только один раз. Обычно это хорошее предположение, но когда это плохое предположение, GHC может создать очень плохой код. Разработчики довольно долго пытались найти способ получить хорошее без плохого. Я думаю, что Йоахим Брайтнер сейчас над этим работает.replicateM_
, и GHC ошибочно переместит вычисления из-за пределовreplicateM_
внутрь, следовательно, повторяет их.Ответы:
Думаю, пора на этот вопрос получить правильный ответ.
Что случилось с вашим кодом с
-O
Позвольте мне увеличить вашу основную функцию и немного ее переписать:
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
Очевидно, что здесь подразумевается, что объект
NodeArray
создается один раз, а затем используется при каждомm
вызовеquery
.К сожалению, GHC фактически преобразует этот код в
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
и тут проблема сразу видна.
Что такое State hack и почему он снижает производительность моих программ
Причина - в государственной хитрости, которая гласит (примерно): «Когда что-то относится к типу
IO a
, предположим, что это вызывается только один раз». Официальная документация не намного более сложный:Грубо говоря, идея такова: если вы определяете функцию с
IO
типом и предложением where, напримерfoo x = do putStrLn y putStrLn y where y = ...x...
Что-то типичное
IO a
можно рассматривать как нечто типичноеRealWord -> (a, RealWorld)
. С этой точки зрения вышеизложенное становится (примерно)foo x = let y = ...x... in \world1 -> let (world2, ()) = putStrLn y world1 let (world3, ()) = putStrLn y world2 in (world3, ())
Звонок в
foo
(обычно) выглядел бы такfoo argument world
. Но определениеfoo
принимает только один аргумент, а второй используется только позже локальным лямбда-выражением! Это будет очень медленный звонокfoo
. Было бы намного быстрее, если бы код выглядел так:foo x world1 = let y = ...x... in let (world2, ()) = putStrLn y world1 let (world3, ()) = putStrLn y world2 in (world3, ())
Это называется эта-расширением и выполняется по разным причинам (например, путем анализа определения функции , проверки того, как она вызывается , и - в данном случае - эвристики, ориентированной на тип).
К сожалению, это снижает производительность, если вызов
foo
действительно имеет формуlet fooArgument = foo argument
, то есть с аргументом, но неworld
передан (пока). В исходном коде iffooArgument
, затем используется несколько раз, по-y
прежнему будет вычисляться только один раз и использоваться совместно. В измененном кодеy
будет каждый раз пересчитываться - именно то, что произошло с вашимnodes
.Что можно исправить?
Возможно. См. # 9388 для попытки сделать это. Проблема с его исправлением заключается в том, что это будет стоить производительности во многих случаях, когда преобразование происходит нормально, даже если компилятор не может знать этого наверняка. И, вероятно, есть случаи, когда это технически не в порядке, т. Е. Совместное использование теряется, но оно все же полезно, потому что ускорение от более быстрого вызова перевешивает дополнительные затраты на пересчет. Так что непонятно, куда идти дальше.
источник
foo
»?-f-no-state-hack
при компиляции кажется довольно тяжелым.{-# NOINLINE #-}
кажется очевидным, но я не могу придумать, как это применить здесь. Возможно, было бы достаточно просто выполнитьnodes
действие ввода-вывода и полагаться на последовательность>>=
?replicateM_ n foo
сforM_ (\_ -> foo) [1..n]
помогает.