[解決済み] この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
(これは全く同じコードで コードレビュー と全く同じコードですが、この質問は別の問題を扱っています)。
これは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
どのように解決するのですか?
でのコードはどうなったのでしょうか?
-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
となっており、ここですぐに問題がわかると思います。
ステートハックとは何か、そしてなぜ私のプログラムのパフォーマンスを破壊するのか
その理由は、ステート・ハックにあります。"何かが型
IO a
型であるとき、それは一度だけ呼ばれると仮定する。というものです。
公式ドキュメント
はあまり詳しくありません。
-fno-state-hack
State# トークンを引数に持つラムダはシングルエントリーであるとみなされるため、その内部でインライン化しても問題ないとされる "state hack" をオフにします。これはIOと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, ())
これはエタ展開と呼ばれ、様々な根拠で行われています(例として は関数の定義を分析する によって、あるいは どのように呼び出されているかをチェックする そして - この場合 - 型指向のヒューリスティック)。
残念ながら、これは、もし
foo
の呼び出しが実際には
let fooArgument = foo argument
という形、つまり引数はあるが
world
は渡されていない(まだ)。元のコードでは、もし
fooArgument
はその後何度か使われています。
y
はまだ一度だけ計算され、共有されます。修正後のコードでは
y
は毎回再計算されることになります。
nodes
.
物事は修正できるのか?
可能性があります。参照 #9388 を参照してください。それを修正する際の問題点は になります。 というのは、コンパイラは確実にそれを知ることができないにもかかわらず、変換がたまたまうまくいく多くのケースでパフォーマンスを犠牲にするからです。また、技術的には問題ない、つまり共有が失われるケースもあるでしょうが、より速い呼び出しによるスピードアップが再計算の余分なコストを上回るので、まだ有益です。したがって、ここからどこへ行くかは明確ではありません。
関連
-
[解決済み] Haskellで "length "関数を使用しない場合のリストの長さ
-
[解決済み] Collatz予想の検証を行うC++のコードは、なぜ手書きのアセンブリよりも高速に動作するのでしょうか?
-
[解決済み] Project Eulerとの速度比較。CとPythonとErlangとHaskellの比較
-
[解決済み】代数的なデータ型の代数を悪用する - なぜこれが有効なのか?
-
[解決済み】Haskellの宣言におけるエクスクラメーションマークの意味とは?
-
[解決済み] RustのtraitとHaskellのtypeclassの違いは何ですか?
-
[解決済み】Haskellの入門編
-
[解決済み】Haskell/GHCの`forall`キーワードは何をするのですか?
-
[解決済み] Haskellの派生はどのように行われるのですか?
-
[解決済み] Haskellってなんで流行ってるの?[クローズド]
最新
-
nginxです。[emerg] 0.0.0.0:80 への bind() に失敗しました (98: アドレスは既に使用中です)
-
htmlページでギリシャ文字を使うには
-
ピュアhtml+cssでの要素読み込み効果
-
純粋なhtml + cssで五輪を実現するサンプルコード
-
ナビゲーションバー・ドロップダウンメニューのHTML+CSSサンプルコード
-
タイピング効果を実現するピュアhtml+css
-
htmlの選択ボックスのプレースホルダー作成に関する質問
-
html css3 伸縮しない 画像表示効果
-
トップナビゲーションバーメニュー作成用HTML+CSS
-
html+css 実装 サイバーパンク風ボタン
おすすめ
-
[解決済み] 一般的に `{- |` で始まるHaskellのコメントは何を意味するのですか?
-
[解決済み] Haskellで "length "関数を使用しない場合のリストの長さ
-
[解決済み] Haskell Preludeの'const'は何のためにあるのか?
-
[解決済み] 解釈の仕方 (Eq a)
-
[解決済み] .の違いは何ですか?(ドット)と$(ドルマーク)の違いは何ですか?
-
[解決済み] TLSサーバーを実装するためのHsOpenSSL APIの適切な使用法
-
[解決済み] <*>は何と呼ばれ、何をするのですか?[クローズド]
-
[解決済み] Haskellには末尾再帰的最適化があるか?
-
[解決済み] Haskell: なぜヘルパー関数に "go" という名前を付けるのですか?
-
[解決済み] HaskellでHaskellインタプリタを書く