キャミバ様が id:ymotongpoo を木人形にされるようです

事の次第

@camlspotter「めんどくせ、あいつに押し付けよ…
@camloeba「おれには強く型付けされたコードが必要だ! あらゆる実験にたえうる木人形がな!ぶつぶつ‥
@camlspotter: 「キャミバ様、実はこんなものが…
@camloeba「ほう…

||||||:::::::;:::::;;;;;;;;;;;;;;;;;;;;;;;;;;;;::::::::|     | |::::::;;;;;;;;;;;;;;;;;;;;;;;;;;;;:::::::::::::::||||||| 
|||||::::::::::/   ●   \:::|    |:::/   ●   \::::::::::||||||| 
|||::::::::;;;;;;;──────;;;;;;;;|    |;;;;;;──────;;;;;;;;;;:::::|||||| 
|;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;,,   ,,;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;:::::|||||| 


@camloeba「どうやらきさまは最高の木人形のようだ!

Caml行くところ乱あり!

オリジナルから dead code は取り除いてある:

(**
* memoizing just a result of each number, i.e. do not memo
* result of atomic and separate.
*)
  let map f l = List.rev (List.rev_map f l)
  let enclose x = "(" ^ x ^ ")"
  let cross lhs rhs =
  let rec cross_aux accu = function
    | [] -> accu
    | x::xs -> cross_aux (List.fold_left (fun a y -> (x^y)::a) accu rhs) xs
  in
  cross_aux [] lhs
  ;;

  let fast_solver tbl atbl stbl n =
    let rec solution n =
      match n with
      | 0 -> []
      | n when n < 0 -> prerr_int n; invalid_arg "solution"
      | n ->
          if Hashtbl.mem tbl n
          then Hashtbl.find tbl n
          else
            begin
              let v = List.rev_append (atomic n) (separate n) in
              Hashtbl.add tbl n v;
              v
            end
    and atomic n =
      match n with
      | 1 -> ["()"]
      | n ->
          if Hashtbl.mem atbl n
          then Hashtbl.find atbl n
          else
            begin
              let v = map enclose (solution (n-1)) in
              Hashtbl.add atbl n v;
              v
            end
    and separate n =
      let rec separate_aux accu = function
        | 0 -> accu
        | k -> separate_aux (List.rev_append (cross (atomic k) (solution (n-k))) accu) (pred k)
      in
      if Hashtbl.mem stbl n
      then Hashtbl.find stbl n
      else
        begin
          let v = separate_aux [] (n-1) in
          Hashtbl.add stbl n v;
          v
        end
    in
    solution n
  ;;

  let fast_test buf num =
    begin
      let tbl = Hashtbl.create buf
      and atbl = Hashtbl.create buf
      and stbl = Hashtbl.create buf in
      print_endline "*** fast test start ***";
      Printf.printf "%d\n%!" (List.length (fast_solver tbl atbl stbl num));
    end
  ;;

let _ = fast_test 100 14

キャミバ様がレビュー!!

(註: キャミバ様は乱世の覇者! ひ弱な坊やは彼独自の最適化理論からいい部分だけを読み取ろうね!)
ふむ… これが貴様のマシンか:

CPU 	Intel Core 2 Duo L7500 1.60GHz
RAM 	2.97GB
OS 	Windows XP SP3 (Cygwin 1.7.1)
OCaml 	3.12.0 

おれのマシンと比べられんから何とも言えんが、まず基本中の基本から…
おい、お前、お前の使ったコンパイラの名前を言ってみろ!
ocamlopt でコンパイルしたんだろうな?
まさかとは思うが、ocamlc でコンパイルしてたなど言ってみろ。その時点でお前はもう死んでいる。 おっと、これはハスケロウの好きな台詞だったな。Lazy だから死んでる事も気づかんのだ。

まあいい、おれの環境では ocamlc で 3.6sec、 ocamlopt で 2.6sec。実はそんなに酷くは変わらん例だ。おれの新秘孔を使えばどちらの環境でも早くなろう!!

ところで、これは一体何をするプログラムなのだ?ふん、まあいい。何か計算して結果が合ってればいいのだろう! おれは暗殺言語OCamlの真の伝承者! さすがに

let _ = print_string "*** fast test start ***
2674440
"

などと書いて高速化したとは言わん! GHC 等は -O20 位付ければそれ位しそうだがな!! ふぁははは!

末尾最適化!

let map f l = List.rev (List.rev_map f l)

ほう! List.map では無く tail recursion 版の map を自分で作っているのか! うむ…気に入った! この例では最大で 742900要素のリストに対して map を行うが、ここまで長いと List.map はスタックを全部使い切って環境によっては Seg fault するぞ!

オリジナル : 2.6sec
List.map : 3.7sec + Seg fault

文字列生成を避ける!

  let enclose x = "(" ^ x ^ ")"

んん〜〜?何だこのコードは?ミッフィーちゃんか? ( ^ x ^ ) どうやら括弧を大量に作るようだが…文字連結一回でアロケーションが一回起こっている事を知らんのか?上のコードでは二回!そして一つしか括弧が付いていない文字列はただ捨てられる! 甘いわ! おまえのように甘い男では暗殺言語であるOCamlは伝承していくことはできん!!
どれ おれが治してやろう。

  let enclose x = 
    let len = String.length x in (* 三度呼ぶなど勿体ないわ *)
    let s = String.create (len + 2) in
    String.blit x 0 s 1 len;
    s.[0] <- '(';
    s.[len+1] <- ')';
    s

結果: 2.6sec => 2.45sec

そうだ副作用だ!破壊的代入だ!
ハスケロウ、破壊的代入はいいぞ!!
いいか、OCamlには妙な自動最適化など無いと知れい!そんな物はコンパイラバグの温床に過ぎん!最適化は自分でやれ!そうすればちゃんと数字に帰ってくる、それがOCamlの良さよ!

fold を見抜く眼力!

  let cross lhs rhs =
    let rec cross_aux accu = function
      | [] -> accu
      | x::xs -> cross_aux (List.fold_left (fun a y -> (x^y)::a) accu rhs) xs
    in
    cross_aux [] lhs

ふん、おれ程の視力の前では cross_aux などただの fold に過ぎんわ!

  let cross lhs rhs = List.fold_left (fun accu x ->
    List.fold_left (fun a y -> (x^y)::a) accu rhs) [] lhs

fold を見抜く眼力が無ければ美しい暗殺言語は書けぬ!
どうやら power set を作って文字列結合したいようだが、これも何とかできるかもしれんな! しかし面倒だから飛ばすぞ!

function!

    let rec solution n =
      match n with
      | 0 -> []
      | n when n < 0 -> prerr_int n; invalid_arg "solution"
      ...

なんだ…これは… function を使えい!

    let rec solution = function
      | 0 -> []
      | n when n < 0 -> prerr_int n; invalid_arg "solution"
      ...

atomic も直しておけ!!

結果: 少し美しくなった。スピードは変わらない。 let f n = match n with => let f = function は内部では全く同じ

Dupe code! お前のコードはすでに死んでいる!!

          if Hashtbl.mem tbl n
          then Hashtbl.find tbl n
          else
            begin
              let v = List.rev_append (atomic n) (separate n) in
              Hashtbl.add tbl n v;
              v
            end

なぜ Hashtbl.mem, Hashtbl.find で二回同じテーブルアクセスを行うのだ!?

          try Hashtbl.find tbl n with Not_found ->
              let v = List.rev_append (atomic n) (separate n) in
              Hashtbl.add tbl n v;
              v

この方が余程良いわ!!

結果 : 変化なし (int での Hashtbl アクセスは、サイズが大きければ、ほとんど配列アクセスとコストが変わらないので 2回も1回も変わらない)

何と…他にも二回ほど同じようなコードがあるな! いいか、
コピペはバグる、いつかバグる。バグが無くってもバグる。
これを肝に命じておけぃ!!

module Hashtbl = struct
  include Hashtbl

  let find_or_add tbl n f =
    try Hashtbl.find tbl n with Not_found ->
      let v = f n in
      Hashtbl.add tbl n v;
      v
end

Hashtbl を拡張してコレを使うのだぁ! これがキャミバ流北、じゃなかった暗黒OCaml

Hashtbl size を調整!!

おい…このテーブルにアクセスするキーは 1 から fast_test の引数 num までしか取ってないぞ?何をやっているんだ?整数 nのHash値は nだから、テーブルのバケットも 1 から num しか使わねぇ。なんでこのテーブルにサイズ100もやる必要がある!? num + 1 で十分だろう?!

  let fast_test num =
      let buf = num + 1 in
      let tbl = Hashtbl.create buf
      and atbl = Hashtbl.create buf
      and stbl = Hashtbl.create buf in
      print_endline "*** fast test start ***";
      Printf.printf "%d\n%!" (List.length (fast_solver tbl atbl stbl num));

  ;;

  let _ = fast_test 14

お前には Hashtbl さえ生ぬるい! Array でキャッシュ!

そしてそもそも num が異様に大きい問題など誰も解かん。バケットの先に alist が付いている事さぇわずらわしいわ! お前には Array.create num で十分!!

module Cache = struct
  let create size = Array.create size None

  let find_or_add tbl n f =
    match tbl.(n) with
    | Some v -> v
    | None -> 
	let v = f n in
	tbl.(n) <- Some v;
	v
end

これを Hashtbl の変わりに使えば早くなる…まあ、その違いはお前の目には最早見えんがな! (汗

結果: スピードは変化しない

遅延評価!!

ふん、しかしこれでも配列の中に option が入っているのが気になるな…どうしたものか…
何だ、lazy でいいじゃねえか。もう一度いう おれは天才だ!!

  let fast_test num =
    let buf = num + 1 in
    let solutions = Array.create buf (lazy [])
    and atomics = Array.create buf (lazy [])
    and separates = Array.create buf (lazy []) in
    let solution n = Lazy.force solutions.(n) 
    and atomic n = Lazy.force atomics.(n)
    and separate n = Lazy.force separates.(n) in
    print_endline "*** fast test start ***";
    for i = 0 to num do
      solutions.(i) <- lazy (match i with
	| 0 -> []
	| n when n < 0 -> prerr_int n; invalid_arg "solution"
	| n -> List.rev_append (atomic n) (separate n));
      atomics.(i) <- lazy (match i with
	| 1 -> ["()"]
	| n -> map enclose (solution (n-1)));
      separates.(i) <- lazy (
	let rec separate_aux accu = function
          | 0 -> accu
          | k -> separate_aux (List.rev_append (cross (atomic k) (solution (i-k))) accu) (pred k)
	in
	separate_aux [] (i-1))
    done;
    Printf.printf "%d\n%!" (List.length (solution num));
  ;;

媚びろ〜!! 媚びろ〜!! おれは天才だ ファハハハ!!

結果: スピードは変化しない

な なにィ え!! ううっ う……!!
ま、まあ、何事もやりすぎは良くないな…Cache.find_or_add まで戻すか。

メモリ確保を避けよ!!!

しかし色々やったが、あまり早くならんな… enclose は直したとして、未だ cross で文字列連結をやっているのが気になる…
ん…なんなんだ、これは?
ウワッハハ!! きさまには致命的な弱点があることを教えてやるわ!! これだあ〜〜っ!!
fast_solver が返すリストの文字列の長さは常に num * 2!! 何故長さが決まっているものをいちいち動的に作る!?
それにしてもおまえも ほとほと甘い男 まだまだコードにとまどいがあった それが命とりだったな!!
暗黒OCamlでは、最後の最後まで、文字列は作らん! そして最後の瞬間に一回の文字列生成で敵を仕留めるのだぁ!!

アルゴリズムを再検討しろ!!!

しょうがない、ついでだ。そろそろ id:nishio の問題文を読んでやろうか:

これは「対応が取れている括弧」が何通りあるか列挙している。() はありだけど )( は開く前に閉じているからNG、((()))はありだけど())(()は開く前に閉じているからNG

なんだ?これは?単に要するにプログラムのインデントレベルと同じで帳尻を合わして最初と最後が0、途中で負にならない、そういう問題ではないか。なぜ、そういうプログラムを書かん!

  let rec even_faster_solver num =
    let buf = String.create num in (* 作業領域だ! 乱世は資源不足! エコ!だな! *)
    let strings = ref [] in
    (* curopens : 今貴様が開いている社会の窓の数だ!
       left : 後何回貴様が人生をやり直せるかだ!
    *)
    let rec solver curopens left =
      let pos = num - left in (* 現在位置 *)
      if left = 0 then (* 貴様はもう死んでいる! 埋め終わったので退避 *)
	strings := String.copy buf :: !strings
      else if curopens = left then begin
	(* ファハハハ、もう後が無いぞ! 閉じるしかない! *)
	buf.[pos] <- ')'; solver (curopens-1) (left-1)
      end else if curopens = 0 then begin
	(* ファハハハ、さあお前の社会の窓を開いてみろ! *)
	buf.[pos] <- '('; solver (curopens+1) (left-1)
      end else begin
        (* フン、開くか閉じるかお前の好きにするがいい! *)
	buf.[pos] <- '('; solver (curopens+1) (left-1);
	buf.[pos] <- ')'; solver (curopens-1) (left-1)
      end
    in
    solver 0 num;
(* 
    List.iter (fun s -> prerr_endline s) !strings;
*)
    !strings

  let even_faster_test num =
    print_endline "*** even faster test start ***";
    Printf.printf "%d\n%!" (List.length (even_faster_solver (num*2)))
  ;;

let _ = even_faster_test 14

(ここでキャミバ様になぜ初めに問題を読まなかったのか聞いてはいけません。)
ん〜!? なんのことかな フフフ…
どうだ! これを見てみろ! 成功したぞ、おまえのプログラムのスピードは倍になった!!

結果 : 2.45sec => 1.28sec

Tail recursion じゃない?気にするな! どうせ再帰レベルは 28 しかない!! 無駄な最適化はせんことだ!
それよりも文字列生成回数を回答数と同じにまで減らす、この事の方が強力なのだ!!

境界検査を省く!!!!

おれは天才だ! 奇跡か… そのぐらいの事 おれにもできる!! この秘孔を使えば、コードを一文字も変えずに高速化する! 激振孔〜〜っ!!

$ ocamlopt -unsafe camloeba.ml

結果 : 1.28sec => 1.265sec

フ…心配するな 天才のコードに buffer overflow や off-by-one error は存在しない!! 心配なら Coq で証明してみろ! お前がな!!

最終奥義: 暗黒OCamlGC さえ統御する!!!!

フフフ…せっかくだ。冥土の土産にキャミバ流暗黒OCamlの最終奥義を見せてやろう! 秘孔戦癰!!

let control = Gc.get ()
let _ = Gc.set { control 
		 with Gc.minor_heap_size = 3200000;
		   space_overhead = max_int;
               }

フフ…動けまい!! 秘孔戦癰を突いた。きさまのGCはピクとも動かん!!フハハハ!!

結果 : 1.28sec => 0.99sec
minor/major GC の数 : (979,15) => (11,0)

どうだぁ、おれは天才だ!! おれの手でOCamlプログラミングは生まれかわるのだ!!

まとめ: キャミバ流暗黒OCamlの力

総合結果 : 2.6sec => 0.99sec

おれの手でOCamlはより強靭になり、より恐怖の言語となる!! スピードを上げるのは purity ではない!欲望だ!!
関数型で統御された破壊的操作だ!!

The bottom line

しかし… 今気づいたんだが、なんで括弧で溢れる文字列を作る必要があるんだ?! 意味がねぇ。全部とりあえず整数にして:

  let rec even_faster_solver num =
    (* curopens : 今貴様が開いている社会の窓の数だ!
       left : 後何回貴様が人生をやり直せるかだ!
    *)
    let rec solver curopens left =
      if left = 0 then 1 (* 貴様はもう死んでいる! *)
      else if curopens = left then solver (curopens-1) (left-1)
      else if curopens = 0 then solver (curopens+1) (left-1)
      else solver (curopens+1) (left-1) + solver (curopens-1) (left-1)
    in
    solver 0 num

  let even_faster_test num =
    print_endline "*** even faster test start ***";
    Printf.printf "%d\n%!" (even_faster_solver (num*2))
  ;;

let _ = even_faster_test 14

結果 : 0.99sec => 0.05sec

さらに、memoizationを入れてやるぅ:

module Hashtbl = struct
  include Hashtbl
  let find_or_add tbl n f =
    try Hashtbl.find tbl n with Not_found ->
      let v = f n in
      Hashtbl.add tbl n v;
      v
end

  let rec even_faster_solver num =
    let tbl = Hashtbl.create ((num+1) * (num+1)) in 
    (* curopens : currently open parens
       left : left space size
    *)
    let rec solver_ (curopens, left) =
      if left = 0 then 1 
      else if curopens = left then solver (curopens-1, left-1)
      else if curopens = 0 then solver (curopens+1, left-1)
      else solver (curopens+1, left-1) + solver (curopens-1, left-1)

    and solver key = 
      Hashtbl.find_or_add tbl key solver_
    in
    solver (0, num)

  let even_faster_test num =
    print_endline "*** even faster test start ***";
    Printf.printf "%d\n%!" (even_faster_solver (num*2))
  ;;

let _ = even_faster_test 14

結果 : 0.05sec => 0.008sec
終結果 : 2.6sec => 0.008sec

おれは何で頑張って文字列操作の最適化書いてたんだ?! 最後の数字が欲しいだけなら意味がねぇ!!!
うわっ うわああ うわらば

OCamlで最適化する時のキャミバ流Tips

  • まず問題を良く読み、アルゴリズムを再検討しよう
  • 末尾再帰に気をつけよう
  • 無駄なデータの計算は避けよう
  • リスト系再帰関数を書いたら、fold かどうか確認しよう。大体が fold で綺麗に書けるはず
  • Duplicated コードは出来るだけ共有化しよう
  • OCaml は自動的なコード最適化はほとんど行わない。それでも十分早い!さらに、工夫すればするだけスピードが上がり、そしてそのゲインは大体予想できる
  • 関数型パラダイムの元で破壊的操作は十分に統御可能。OCaml では purity にこだわるな!
  • 境界問題が発生しない場合は unsafe 操作も恐れずに使用しよう
  • 瞬間的にスピードが必要な場合、GC を一時的に止める事も考えよう