SSブログ

入力値をソートするプログラムを Camlp4 で生成 [OCaml]

どう書くorgの問題の回答なのだけど今サイトが落ちてるみたいなのでこっちの記事にしてしまうことにしました。「『ユーザからの整数の入力を変数に入れてそれらを if だけでソートするプログラム』を生成するプログラムを書け」という問題です。既に投稿されていた shiro さんの Scheme のコードを参考にしつつ OCaml + Camlp4 3.9 で書きました。実は Camlp4 を使わないほうが楽に書けたのではないかという気も。

(*
#load "camlp4o.cma";;
#load "q_MLast.cmo";;
#load "pr_o.cmo";;

ocamlopt -pp 'camlp4o q_MLast.cmo' \
  -I +camlp4 gramlib.cmxa camlp4.cmxa pa_o.cmx pr_o.cmx -o gensort gensort.ml
*)

let _loc = Token.dummy_loc;;

let var_of_int n = String.make 1 (char_of_int (n + 97));;
let vars n = Array.to_list (Array.init n var_of_int);;

let make_lid_list lids =
  List.fold_right (fun x l -> <:expr< [$lid:x$ :: $l$] >>) lids <:expr< [] >>;;

let wrap_fun args e = 
  List.fold_right (fun x l -> <:expr< fun $lid:x$ -> $l$ >>) args e;;

let rec gencode sorted = function
| [] -> <:expr<
    print_int_list $make_lid_list (List.rev sorted)$
  >>
| u::us ->
  let rec insert rs = function
  | [] -> gencode (List.rev (u::rs)) us
  | s::ss -> <:expr<
      if $lid:s$ < $lid:u$ then
        $(gencode (List.rev (u::rs) @ s::ss) us)$
      else
        $(insert (s::rs) ss)$
    >>
  in
  insert [] sorted;;

let gensort n = 
  let vars = vars n in
  let fmt = String.concat " " (Array.to_list (Array.make n "%d")) in
  let e = gencode [] vars in
  let f = wrap_fun vars e in
  let s = <:str_item<
    let print_int_list xs = do {
      List.iter (fun x -> do {print_int x; print_string " "}) xs;
      print_newline ()
    }
    in
    Scanf.scanf $str:fmt$ $f$
    >>
  in
  (!Pcaml.print_implem) [s, _loc];;

gensort (int_of_string Sys.argv.(1))

生成、コンパイル、実行の結果。

KURO-BOX% ocamlopt -pp 'camlp4o q_MLast.cmo' \
  -I +camlp4 gramlib.cmxa camlp4.cmxa pa_o.cmx pr_o.cmx -o gensort gensort.ml
KURO-BOX% for n in 1 2 3 4 5 6 7; do time ./gensort $n > a$n.ml; done
./gensort $n > a$n.ml  0.03s user 0.04s system 95% cpu 0.073 total
./gensort $n > a$n.ml  0.02s user 0.05s system 94% cpu 0.074 total
./gensort $n > a$n.ml  0.06s user 0.02s system 97% cpu 0.082 total
./gensort $n > a$n.ml  0.09s user 0.03s system 99% cpu 0.121 total
./gensort $n > a$n.ml  0.33s user 0.03s system 99% cpu 0.363 total
./gensort $n > a$n.ml  2.01s user 0.05s system 99% cpu 2.066 total
./gensort $n > a$n.ml  15.66s user 0.34s system 99% cpu 16.003 total
KURO-BOX% for n in 1 2 3 4 5 6 7; do time ocamlc -o a$n a$n.ml; done
ocamlc -o a$n a$n.ml  0.25s user 0.07s system 97% cpu 0.327 total
ocamlc -o a$n a$n.ml  0.24s user 0.09s system 98% cpu 0.336 total
ocamlc -o a$n a$n.ml  0.30s user 0.05s system 99% cpu 0.351 total
ocamlc -o a$n a$n.ml  0.36s user 0.08s system 101% cpu 0.435 total
ocamlc -o a$n a$n.ml  0.91s user 0.08s system 99% cpu 0.992 total
ocamlc -o a$n a$n.ml  6.06s user 0.13s system 99% cpu 6.191 total
ocamlc -o a$n a$n.ml  108.27s user 0.58s system 99% cpu 1:48.87 total
KURO-BOX% ./a6
5 2 4 6 1 3
1 2 3 4 5 6

生成されるのはこんな感じのコード(値が3のとき)。

let _ =
  let print_int_list xs =
    List.iter (fun x -> print_int x; print_string " ") xs; print_newline ()
  in
  Scanf.scanf "%d %d %d"
    (fun a b c ->
       if a < b then
         if b < c then print_int_list [a; b; c]
         else if a < c then print_int_list [a; c; b]
         else print_int_list [c; a; b]
       else if a < c then print_int_list [b; a; c]
       else if b < c then print_int_list [b; c; a]
       else print_int_list [c; b; a])

nice!(0)  コメント(0)  トラックバック(0) 
共通テーマ:パソコン・インターネット

nice! 0

コメント 0

コメントを書く

お名前:
URL:
コメント:
画像認証:
下の画像に表示されている文字を入力してください。

トラックバック 0

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。