Почему этот код Haskell работает медленнее с -O?
Этот фрагмент кода 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
(Это точно такой же код с обзором кода, но этот вопрос касается другой проблемы.)
Это мой входной генератор в С++:
#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);
}
}
Если у вас нет компилятора С++, это результат ./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
Ответы
Ответ 1
Думаю, пришло время ответить на этот вопрос.
Что случилось с вашим кодом с помощью -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 invocations 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
и вы можете сразу увидеть проблему здесь.
Что такое взлом состояния и почему он разрушает производительность моих программ
Причиной является взлом состояния, в котором говорится (примерно): "Когда что-то имеет тип IO a, предположим, что он вызывается только один раз". Официальная документация не намного сложнее:
-fno-state-hack
Отключить "взлом состояния", при котором любая лямбда с маркером состояния # в качестве аргумента считается однократной, поэтому считается, что внутри внутри нее есть встроенные элементы. Это может повысить производительность кодов ввода-вывода и ST, но это снижает риск совместного использования.
Грубо говоря, идея такова: если вы определяете функцию с типом 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, ())
Это называется eta-расширением и выполняется по разным причинам (например, анализ определения функций, проверка того, как он называется, и - в этом случае - тип направленной эвристики).
К сожалению, это необоснованно, если вызов foo фактически имеет вид let fooArgument = foo argument, то есть с аргументом, но no world прошел (пока). В исходном коде, если fooArgument используется несколько раз, y будет вычисляться только один раз и совместно использовать. В модифицированном коде y будет перерасчитываться каждый раз - точно, что произошло с вашим nodes.
Можно ли зафиксировать вещи?
Возможно. См. # 9388 за попытку сделать это. Проблема с исправлением заключается в том, что во многих случаях это будет стоить производительности, когда преобразование происходит нормально, хотя компилятор не может точно это знать. И, вероятно, есть случаи, когда технически это не нормально, т.е. Разделение теряется, но это все же полезно, потому что ускорение от более быстрого вызова перевешивает дополнительную стоимость пересчета. Поэтому неясно, куда идти отсюда.
