M.Hiroi's Home Page

Functional Programming

お気楽 OCaml プログラミング入門

[ PrevPage | OCaml | NextPage ]

ファイル入出力

OCaml は「チャネル (channel)」というデータ型を介して入出力処理を行います。チャネルは、いわゆるチャンネルのことで、もともとは水路とか海峡という意味ですが、コンピュータの世界では通信路とか伝送路の意味で使われています。

C言語や Common Lisp など近代的なプログラミング言語は「ストリーム (stream)」とういデータ型を介してデータの入出力を行います。OCaml のチャネルはストリームと同じものです。今回はファイルの入出力について簡単に説明します。

●標準入出力

OCaml では、チャネルを介してファイルにアクセスします。チャネルはファイルと 1 対 1 に対応していて、ファイルからデータを入力するときは、チャネルを経由してデータが渡されます。逆に、ファイルへデータを出力するときもストリームを経由します。入力チャネル表すデータ型が in_channel で、出力チャネルを表すデータ型が out_channel です。

通常のファイルは、チャネルを生成しないとアクセスすることはできません。ただし、標準入出力は OCaml の起動時にチャネルが自動的に生成されるので、簡単に利用することができます。一般に、キーボードからの入力を「標準入力」、画面への出力を「標準出力」といいます。標準入出力に対応するチャネルは大域変数に格納されています。表 1 に変数名を示します。

表 1 : 標準入出力
変数名ファイル
stdin 標準入力
stdout 標準出力
stderr 標準エラー出力

データの入出力処理は標準入出力を使うと簡単です。たとえば、print_string は文字列を標準出力へ出力する関数でしたが、入力チャネルから文字列を読み込む関数が read_line です。

val read_string : unit -> string = <fun>
# read_line ();;
hello, world
- : string = "hello, world"

hello, world と入力してリターンキーを押すと、read_line は入力データを文字列にして返します。このとき、改行文字が取り除かれることに注意してください。また、read_line はファイルの終了を検出すると例外 End_of_file を送出します。

それでは簡単な例題として、入力をそのままエコーバックする関数 echo を作ってみましょう。プログラムは次のようになります。

リスト 1 : エコーバック

let echo () =
  let rec echo_sub () =
    print_string (read_line ());
    print_newline ();
    echo_sub ()
  in
    try echo_sub () with End_of_file -> ()

実際の処理は局所関数 echo_sub で行っています。標準入力から read_line で 1 行読み込み、それを print_string で標準出力へ出力します。改行は取り除かれているので、print_newline で改行を付け加えます。なお、OCaml には文字列と改行を出力する関数 print_endline も用意されているので、そちらを使ったほうが簡単でしょう。

あとは echo_sub を再帰呼び出しするだけですが、ファイルの終了時には例外 End_of_file が送出されるので、それを try 式で受け取ります。echo_sub は再帰呼び出しの停止条件がない、つまり「無限ループ」になっているので、例外を送出しないとプログラムを停止できないことに注意してください。

簡単な実行例を示します。

val echo : unit -> unit = <fun>
# echo ();;
abcd    <-- 入力
abcd
efgh    <-- 入力
efgh
hello, world    <-- 入力
hello, world

Unix 系 OS の場合、echo を終了するには Ctrl-D を入力してください。

●ファイルのオープンとクローズ

ファイルにアクセスする場合、次の 3 つの操作が基本になります。

  1. アクセスするファイルをオープンする
  2. 入出力関数を使ってファイルを読み書きする。
  3. ファイルをクローズする。

「ファイルをオープンする」とは、アクセスするファイルを指定して、それと 1 対 1に対応するチャネルを生成することです。入出力関数はオープンしたチャネルを経由してファイルにアクセスします。OCaml の場合、ファイルをオープンするには関数 open_in と open_out を使います。オープンしたファイルは必ずクローズしてください。この操作を行う関数が close_in と close_out です。

val open_in   : string -> in_channel = <fun>
val open_out  : string -> out_channel = <fun>
val close_in  : in_channel -> unit = <fun>
val close_out : out_channel -> unit = <fun>

ファイル名は文字列で指定し、ファイル名のパス区切り記号にはスラッシュ ( / ) を使います。\ は文字列のエスケープコードに割り当てられているため、そのままではパス区切り記号に使うことはできません。ご注意くださいませ。また、ファイルのオープンやクローズに失敗した場合は例外 Sys_error が送出されます。

●input_char と output_char

OCaml で用意されている、主な入出力関数を次に示します。

読み込み
val intput_char : in_channel -> char = <fun>
val intput_line : in_channel -> string = <fun>
val intput_byte : in_channel -> int = <fun>

書き込み
val output_char : out_channel -> char -> unit = <fun>
val output_line : out_channel -> string -> unit = <fun>
val output_byte : out_channel -> int -> unit = <fun>

関数 input_char は入力チャネルから 1 文字 (1 byte) 読み込みます。関数 input_line は入力チャネルから 1 行読み込みます。このとき、改行は削除されます。関数 intput_byte は入力チャネルから 1 バイト読み込みます。返り値は整数 (0 - 255) になります。ファイルの終了を検出すると、これらの入力関数は例外 End_of_file を送出します。

関数 output_char は出力チャネルに 1 文字 (1 byte) 書き込みます。関数 output_line は出力チャネルに 1 行書き込みます。関数 output_byte は整数 (n mod 256) を出力チャネルに書き込みます。

それでは簡単な例題として、ファイルの内容を画面へ出力する関数 cat を作ってみましょう。プログラムは次のようになります。

リスト 2 : ファイルの表示 (1)

let cat filename =
  let fin = open_in filename in
  let rec cat_sub () =
    output_char stdout (input_char fin);
    cat_sub ()
  in
    try cat_sub () with End_of_file -> close_in fin

関数 cat の引数 filename はファイル名を表す文字列です。failename をオープンして入力チャネルを変数 fin にセットします。ファイルの表示は局所関数 cat_sub で行います。input_char で 1 文字読み込み、それを output_char で標準出力へ出力します。この処理は関数 print_char を使ってもかまいません。あとは cat_sub を再帰呼び出しします。

cat_sub には再帰呼び出しの停止条件がないので、この処理は「無限ループ」になることに注意してください。cat では cat_sub を呼び出して、例外 End_of_file を try 式で受け取ります。そして、close_in で入力チャネル fin をクローズします。

ところで、cat は再帰呼び出しを使いましたが、繰り返しでも簡単にプログラムを作ることができます。次のリストを見てください。

リスト 3 : ファイルの表示 (2)

let cat1 filename =
  let fin = open_in filename in
  let cat_sub () =
    while true do
      output_char stdout (input_char fin)
    done
  in
    try cat_sub () with End_of_file -> close_in fin

cat_sub では while の条件式に true を指定して「無限ループ」を構成していることに注意してください。例外を使ってファイルの終了をチェックしているので、プログラムはとても簡単になります。

なお、input_char と output_char のかわりに input_line と output_line を使って行単位で入出力を行っても同じようにプログラムを作ることができます。

●ファイルの書き込み

データをファイルに書き込むには、ファイルを open_out でオープンします。このとき、注意事項が一つあります。既に同じ名前のファイルが存在している場合は、そのファイルの長さを 0 に切り詰めてからデータを書き込みます。既存のファイルは内容が破壊されることに注意してください。

それでは簡単な例題として、string list の要素を 1 行ずつファイルに書き込む関数 output_stringlist を作ってみましょう。次のリストを見てください。

リスト 4 : ファイルの書き込み

let output_stringlist filename xs =
  let fout = open_out filename in
  List.iter (fun x -> output_string fout (x ^ "\n")) xs;
  close_out fout

最初に open_out でファイル filename をオープンします。あとは、高階関数 List.iter を使ってリスト xs から要素を一つずつ取り出し、改行文字を付加してから output_string で出力するだけです。

このほかにも、OCaml にはいろいろな入出力関数が用意されています。詳しい説明は OCaml のリファレンスを参照してください。

●問題

次の関数を定義してください。

  1. テキストファイルの先頭 10 行を表示する head_file filename
  2. テキストファイルの最後 10 行を表示する tail_file filename
  3. 2 つのテキストファイルを行単位で連結する paste_file file1 file2
  4. ファイルのエントロピーを計算する entoropy filename
    各記号 ai の出現確率 P(ai) がわかると、次の式でエントロピー H を求めることができます。
    H = - Σ P(ai) * log2 P(ai)  (ビット)
           i
    

エントロピーについては拙作のページ Algorithms with Python シャノン・ファノ符号とハフマン符号 をお読みくださいませ。













●解答1

リスト : ファイルの先頭 10 行を表示する

let head_file filename =
  let fin = open_in filename in
  let head_file_sub () =
    for i = 1 to 10 do
      print_endline (input_line fin)
    done;
    close_in fin
  in
    try head_file_sub () with End_of_file -> close_in fin

open_in で引数 filename をリードオープンします。あとは for ループ で 10 行読み込んで、print_endline で出力します。途中でファイルの終了を検出した場合は例外 End_of_file が送出されるので、それを try 式で捕捉して close_in でファイルをクローズします。

●解答2

リスト : ファイルの末尾 10 行を表示する

let tail_file filename =
  let fin = open_in filename in
  let buff = ref [] in
  let rec tail_file_sub () =
    let xs = input_line fin in
    if List.length !buff < 10 then buff := !buff @ [xs]
    else buff := (List.tl !buff) @ [xs];
    tail_file_sub ()
  in
  try tail_file_sub () with
    End_of_file -> close_in fin; List.iter print_endline !buff

読み込んだ直近の 10 行を変数 buff のリストに保持します。buff の長さが 10 に満たない場合、buff の末尾に読み込んだ行 [xs] を連結します。buff の長さが 10 の場合は、List.tl で先頭要素を取り除いてから [xs] を連結します。ファイルの終了を検出したら List.iter で buff に格納されている行を print_endline で出力します。

なお、このプログラムはリストの連結に @ (append) を使っているので、効率はよくありません。興味のある方はプログラムを改良してみてください。

●解答3

リスト : ファイルを行単位で連結する

let input_one_line fin =
  try
    Some (input_line fin)
  with
    End_of_file -> close_in fin; None

let rec flush_file fin =
  match input_one_line fin with
    None -> ()
  | Some x -> print_endline x; flush_file fin

let paste_file file1 file2 =
  let fin1 = open_in file1 in
  let fin2 = open_in file2 in
  let rec paste_sub () =
    let buff1 = input_one_line fin1 in
    let buff2 = input_one_line fin2 in
    match (buff1, buff2) with
      (None, None) -> ()
    | (Some x, None) -> print_endline x; flush_file fin1
    | (None, Some x) -> print_endline x; flush_file fin2
    | (Some x, Some y) -> print_string x; print_endline y; paste_sub ()
  in paste_sub ()

最初に、引数 file1 と file2 を open_in でリードオープンします。次に関数 input_one_line で 1 行読み込み、変数 buff1 と buff2 にセットします。input_one_line は fin から 1 行読み込み、それを Some に包んで返します。ファイルの終了を検出した場合は、close_in でファイルをクローズしてから None を返します。

次に、match で buff1 と buff2 をパターンマッチングします。どちらも None であればユニット () を返します。(Some x, None) とマッチングしたならば、print_endline で x を出力し、flush_file で fin1 を出力します。逆に、(None, Some x) とマッチングした場合は fin2 を出力します。(Some x, Some y) とマッチングした場合、x と y を出力してから paste_sub を再帰呼び出しします。

●解答4

リスト : ファイルのエントロピーを求める

let make_frequency filename =
  let fin = open_in filename in
  let freq = Array.make 256 0 in
  let rec make_freq () =
    let c = input_byte fin in
    freq.(c) <- freq.(c) + 1;
    make_freq ()
  in
  try make_freq () with End_of_file -> close_in fin; freq

let entoropy filename =
  let freq = make_frequency filename in
  let sum = Array.fold_left (+) 0 freq in
  let e = -. (Array.fold_left
                (fun a x -> if x > 0. then a +. (x *. (log x /. log 2.)) else a)
                0.
                (Array.map (fun x -> (float_of_int x) /. (float_of_int sum)) freq))
  in (sum, e)

関数 make_frequency で記号 (0 - 255) の出現頻度表を作成します。ファイル filename を close_in でリードオープンし、input_byte で 1 バイトずつ読み込みます。あとは記号 c に対して frerq.(c) の値を +1 するだけです。関数 entoropy は各記号の出現確率 p を Array.map で求め、エントロピー e を Array.fold_left で計算します。

それでは、実際に Canterbury Corpus で配布されているテストデータ The Canterbury Corpus のエントロピーを求めてみましょう。

リスト : entoropy のテスト

let test_entoropy () =
  let files = ["alice29.txt"; "asyoulik.txt"; "cp.html"; "fields.c"; "grammar.lsp";
               "kennedy.xls"; "lcet10.txt"; "plrabn12.txt"; "ptt5"; "sum"; "xargs.1"] in
  List.iter
    (fun name -> let (s, e) = entoropy name in
                 Printf.printf "%14s %8d  %f  %6.0f\n" name s e ((float_of_int s) *. e /. 8.))
    files

関数 Printf.printf で結果を出力します。モジュール Printf にはC言語の標準ライブラリ関数 printf に相当する書式出力関数が定義されています。機能はC言語の printf とほぼ同じです。詳細は OCaml のリファレンスマニュアルをお読みください。

# test_entoropy ();;
   alice29.txt   152089  4.567680   86837
  asyoulik.txt   125179  4.808116   75234
       cp.html    24603  5.229137   16082
      fields.c    11150  5.007698    6979
   grammar.lsp     3721  4.632268    2155
   kennedy.xls  1029744  3.573471  459970
    lcet10.txt   426754  4.669118  249071
  plrabn12.txt   481861  4.531363  272936
          ptt5   513216  1.210176   77635
           sum    38240  5.328990   25473
       xargs.1     4227  4.898432    2588
- : unit = ()

各列の項目はファイル名、ファイルサイズ、エントロピー、下限値です。ファイルサイズ * エントロピー / 8 で圧縮の下限値を計算することができます。ただし、この結果は無記憶情報源モデルの場合であり、モデル化によってエントロピーの値は異なることに注意してください。


初版 2008 年 6 月 29 日
改訂 2020 年 7 月 5 日

バックトラック法

複雑な問題を厳密に解こうとするときや、条件を満たす解をすべて求める必要があるとき、可能性のあるパターンをすべて生成して、条件を満たしているかチェックするしか方法がない場合があります。このようなとき用いる手法に「バックトラック法 (backtracking)」があります。

たとえば、簡単な例として迷路を考えてみましょう。ある地点 A で道が左右に分かれているとします。ここで、左の道を選んで先へ進むと、行き止まりになってしまいました。この場合は A 地点まで戻って右の道へ進まないといけません。

このように、失敗したら元に戻って別の選択枝を選ぶ、という試行錯誤を繰り返して解を見つける方法がバックトラック法なのです。バックトラック法は、いろいろな分野の問題に応用できる方法です。そして、再帰定義を使うと簡単にプログラムを作ることができます。今回は簡単な例題として、バックトラック法でパズルを解いてみましょう。

●小町算

パズルの世界では、1 から 9 までの数字を 1 個ずつすべて使った数字を「小町数」といいます。123456789 とか 321654987 のような数字が小町数です。「小町算」というものもあり、123 + 456 + 789 とか 321 * 654 + 987 のようなものです。今回は小町算の中でも特に有名なパズルを解いてみましょう。

[問題] 小町算

1 から 9 までの数字を順番に並べ、間に + と - を補って 100 になる式をすべて求めよ。今回は 1 の先頭に - 符号は付けないものとする。

例 : 1 + 2 + 3 - 4 + 5 + 6 + 78 + 9 = 100

●データ型の定義

この問題は演算子が + と - だけしかないので、式はリストで表すことにします。OCaml の場合、異なるデータ型をリストに格納することはできないので、+ と - と数値を表すデータ型を定義します。

リスト 5 : データ型の定義

type term =  Plus | Minus | Num of int  

term を使うと数式は次のように表すことができます。

1 + 2 + 3 - 4 + 5 + 6 + 78 + 9
=> [Num 1; Plus; Num 2; Plus; Num 3; Minus; Num 4; Plus; 
    Num 5; Plus; Num 6; Plus; Num 78; Plus; Num 9]

あとは、式を生成して値を計算するだけです。式を生成するとき、リストを逆順で管理すると簡単です。次の図を見てください。

[Num 1] => [Num 2, Plus, Num 1]  => [Num 3, Plus, Num 2, Plus, Num 1]
                                 => [Num 3, Minus, Num 2, Plus, Num 1]
                                 => [Num 23, Plus, Num 1]
        => [Num 2, Minus, Num 1] => [Num 3, Plus, Num 2, Minus, Num 1]
                                 => [Num 3, Minus, Num 2, Minus, Num 1]
                                 => [Num 23, Minus, Num 1]
        => [Num 12]              => [Num 3, Plus, Num 12]
                                 => [Num 3, Minus, Num 12]
                                 => [Num 123]


                        図 1 : 式の生成

式を生成するとき、リストに数字と演算子を順番に追加していきます。Num と Plus, Minus を追加する処理は簡単です。プログラムのポイントは数字を連結する処理、たとえば 1 と 2 を連結して一つの数値 12 にする処理です。この処理はリストの先頭の数字 Num 1 を Num 12 (= 1 * 10 + 2) に置き換えることで実現できます。リストが [Num 2, Plus, Num 1] であれば、Num 2 を Num 23 (= 2 * 10 + 3) に置き換えます。

●式の生成

式を生成するプログラムは次のようになります。

リスト 6 : 式の生成

let rec make_expr n expr =
  if n = 10 then
    let expr1 = List.rev expr in
    if calc_expr expr1 = 100 then print_expr expr1 else ()
  else
    match expr with
      Num x :: xs ->
        make_expr (n + 1) (Num n :: Plus :: expr);
        make_expr (n + 1) (Num n :: Minus :: expr);
        make_expr (n + 1) (Num (x * 10 + n) :: xs)
    | _ -> raise (Failure "make_expr")

式の生成はバックトラック法を使うと簡単です。関数 make_exp の引数 n が追加する数字、expr が生成する式(リスト)です。n が 10 になったら式が完成したので値を計算します。関数 List.rev で式を元に戻し、関数 calc_expr で式 expr1 を計算します。その結果が 100 になれば関数 print_expr で式を出力します。

n が 10 より小さい場合は数値と演算子をリストにセットします。最初に Num n と Plus をセットして make_expr を再帰呼び出しします。その次に、Num n と Minsu をセットして make_expr を呼び出します。最後に、Num x を Num (x * 10 + n) に置き換えてから make_expr を呼び出します。これで、全部の数式を生成することができます。

●式の計算

次は式を計算する関数 calc_exp を作ります。今回の問題は演算子に + と - しかないので、リストで表現した式を計算することは簡単です。次のプログラムを見てください。

リスト 7 : 式の計算

let calc_expr expr =
  let rec calc_expr_sub expr a =
    match expr with
      [] -> a
    | Plus :: Num x :: xs -> calc_expr_sub xs (a + x)
    | Minus :: Num x :: xs -> calc_expr_sub xs (a - x)
    | _ -> raise (Failure "calc_expr_sub")
  in
    match expr with
      Num x :: xs -> calc_expr_sub xs x
    | _ -> raise (Failure "calc_expr")

実際の計算処理は局所関数 calc_expr_sub で行います。第 1 引数が数式 (リスト) で、第 2 引数が計算結果です。calc_expr は先頭の数値 x を取り出し、残りの数式を calc_expr_sub の第 1 引数に、x を第 2 引数に渡します。すると、数式の先頭は Plus か Minus になります。

calc_expr_sub では、Plus の場合は次の数値 x を sum に加算し、Minus の場合は sum から減算します。あとは calc_expr_sub を再帰呼び出しするだけです。

あとのプログラムは簡単なので説明は省略いたします。詳細は プログラムリスト1 をお読みください。

●実行結果

それでは実行結果を示します。

# make_expr 2 [Num 1];;
1 + 2 + 3 - 4 + 5 + 6 + 78 + 9 = 100
1 + 2 + 34 - 5 + 67 - 8 + 9 = 100
1 + 23 - 4 + 5 + 6 + 78 - 9 = 100
1 + 23 - 4 + 56 + 7 + 8 + 9 = 100
12 + 3 + 4 + 5 - 6 - 7 + 89 = 100
12 + 3 - 4 + 5 + 67 + 8 + 9 = 100
12 - 3 - 4 + 5 - 6 + 7 + 89 = 100
123 + 4 - 5 + 67 - 89 = 100
123 + 45 - 67 + 8 - 9 = 100
123 - 4 - 5 - 6 - 7 + 8 - 9 = 100
123 - 45 - 67 + 89 = 100
- : unit = ()

全部で 11 通りの解が出力されます。この他にも、いろいろな解き方があると思います。興味のある方は、もっとクールな方法を考えてみてください。

●8 クイーン

もう一つ、有名なパズルを解いてみましょう。8 クイーンはコンピュータに解かせるパズルの中でも特に有名な問題です。8 クイーンは、8 行 8 列のチェスの升目に、8 個のクイーンを互いの利き筋が重ならないように配置する問題です。クイーンは将棋の飛車と角をあわせた駒で、縦横斜めに任意に動くことができます。解答の一例を示します。


    図 2 : 8 クイーンの解答例

8 クイーンを解くには、すべての置き方を試してみるしか方法はありません。最初のクイーンは、盤上の好きなところへ置くことができるので、64 通りの置き方があります。次のクイーンは 63 通り、その次は 62 通りあります。したがって、置き方の総数は 64 から 57 までの整数を掛け算した 178462987637760 通りもあります。

ところが、解答例を見ればわかるように、同じ行と列に 2 つ以上のクイーンを置くことはできません。上図の解答例をリストを使って表すと、 次のようになります。

  1  2  3  4  5  6  7  8    <--- 列の位置
---------------------------
 [1, 7, 5, 8, 2, 4, 6, 3]   <--- 要素が行の位置を表す  


        図 3 : リストでの行と列の表現方法

列をリストの位置に、行番号を要素に対応させれば、各要素には 1 から 8 までの数字が重複しないで入ることになります。すなわち、1 から 8 までの順列の総数である 8! = 40320 通りの置き方を調べるだけでよいのです。パズルを解く場合は、そのパズル固有の性質をうまく使って、調べなければならない場合の数を減らすように工夫することが大切です。

順列を生成するプログラムは 順列と組み合わせ で作成しました。あとは、その順列が 8 クイーンの条件を満たしているかチェックすればいいわけです。このように、正解の可能性があるデータを作りそれをチェックするという方法を「生成検定法 (generate and test)」といいます。

可能性のあるデータをもれなく作るような場合、バックトラック法は最適です。ただし、「生成するデータ数が多くなると時間がとてもかかる」という弱点があるので注意してください。

●プログラムの作成

それでは、プログラムを作りましょう。次のリストを見てください。

リスト 8 : 8 クイーンの解法

(* 盤面の表示 *)
let rec print_board = function
  [] -> print_newline ()
| x :: xs -> print_int x; print_string " "; print_board xs

(* 安全確認 *)
let rec safe = function
  [] -> true
| x :: xs -> if attack x xs then safe xs else false

let rec queen f nums board =
  if nums = [] then
    if safe board then f board else ()
  else
    List.iter (fun x -> queen f (remove x nums) (x :: board)) nums

関数 queen は順列を生成するプログラムと同じです。順列を一つ生成したら、述語 safe で 8 クイーンの条件を満たしているかチェックします。そうであれば、関数 f を呼び出します。print_board を渡すと盤面 (リスト) を表示します。

述語 safe はリストの先頭の要素からチェックしていきます。衝突のチェックは斜めの利き筋を調るだけです。端にあるクイーンから順番に調べるとすると、斜めの利き筋は次のように表せます。

  1 2 3    --> 調べる方向
*-------------
| . . . . . .
| . . . -3. .  5 - 3 = 2
| . . -2. . .  5 - 2 = 3
| . -1. . . .  5 - 1 = 4
| Q . . . . .  Q の位置は 5  
| . +1. . . .  5 + 1 = 6
| . . +2. . .  5 + 2 = 7
| . . . +3. .  5 + 2 = 8
*-------------


    図 4 : 衝突の検出

図を見てもらえばおわかりのように、Q が行 5 にある場合、ひとつ隣の列は 4 と 6 が利き筋に当たります。2 つ隣の列の場合は 3 と 7 が利き筋に当たります。このように単純な足し算と引き算で、利き筋を計算することができます。これをプログラムすると次のようになります。

リスト 9 : 衝突の検出

let attack x xs =
  let rec attack_sub x n = function
      [] -> true
    | y :: ys -> if x = y + n || x = y - n then false
                 else attack_sub x (n + 1) ys
  in
    attack_sub x 1 xs

attack は、斜めの利き筋に当たった場合に false を返し、利き筋に当たらない場合は true を返します。実際の処理は局所関数 attack_sub で行います。attack_sub はリストの先頭から斜めの利き筋に当たるか調べます。第 1 引数がクイーンの位置、第 2 引数が位置の差分、第 3 引数がリストになります。

最初の節がクイーンを全て調べた場合です。クイーンは衝突していないので true を返します。次の節で、リストから先頭の要素 y を取りだし、利き筋に当たるか調べます。これは、y + n または y - n が x と等しいかチェックするだけです。衝突している場合は false を返します。そうでなければ、attack_sub を再帰呼び出しして次のクイーンを調べます。このとき、差分 n の値を +1 することをお忘れなく。

●実行結果

これでプログラムは完成です。それでは実行してみましょう。

# queen print_board [1; 2; 3; 4; 5; 6; 7; 8] [];;
4 2 7 3 6 8 5 1 

... 省略 ...

5 7 2 6 3 1 4 8 
val it = () : unit

解は全部で 92 通りあります。ところで、このプログラムはクイーンの個数を増やすと極端に遅くなります。ocaml でクイーンの個数を増やして試してみたところ、実行時間は次のようになりました。

リスト : N Queens Problem

let rec iota n m =
  if n > m then []
  else n :: iota (n + 1) m

let test_queen f n =
  let c = ref 0 in
  let s = Sys.time () in
  f (fun _ -> c := !c + 1) (iota 1 n) [];
  print_float (Sys.time () -. s);
  !c
表 2 : 実行時間 (秒)
個数 8 9 10
解の個数 92 352 724
queen() 0.047 0.344 3.859

実はこのプログラム、とても非効率なことをやっているのです。

●8 クイーンの高速化

実行速度が遅い理由は、失敗することがわかっている順列も生成してしまうからです。たとえば、最初 (1, 1) の位置にクイーンを置くと、次のクイーンは (2, 2) の位置に置くことはできませんね。したがって、[1; 2; X; X; X; X; X; X] という配置はすべて失敗するのですが、順列を発生させてからチェックする今の方法では、このような無駄を省くことができません。

そこで、クイーンの配置を決めるたびに衝突のチェックを行うことにします。これをプログラムすると次のようになります。

リスト : 8 クイーン (改良版)

let rec queen_fast f nums board =
  if nums = [] then f board
  else List.iter (fun x ->
    if attack x board then queen_fast (remove x nums) (x :: board) else ()) nums

匿名関数の中で、追加したクイーンが board 内のクイーンと衝突していないか関数 attack でチェックします。順列を生成している途中でチェックを入れることで、無駄な順列を生成しないようにするわけです。この場合、safe は必要ありません。

このように、できるだけ早い段階でチェックを入れることで、無駄なデータをカットすることを「枝刈り」と呼びます。バックトラックを使って問題を解く場合、この枝刈りのよしあしによって実行時間が大きく左右されます。ところが、枝刈りの方法はパズルによって違います。パズル固有の性質をよく調べて、適切な枝刈りを考えることが重要なのです。

パズル自体はコンピュータに解かせるのですが、枝刈りの条件は私達が考えるわけです。これも「パズルの解法」の面白いところでしょう。解を求めるだけでなく、いかに効率の良い条件を見つけて実行時間を短縮するか、ということでも楽しむことができます。

それでは、実行結果を表 3 に示します。

表 3 : 実行時間 (秒)
個数 8 9 10 11 12
解の個数 92 352 724 2680 14200
queen 0.047 0.344 3.859 ---- ----
queen_fast 0.016 0,016 0.016 0.203 1.203

このように、枝刈りを行うことで実行時間を大幅に短縮することができます。ところで、今回は単純にリストを出力するだけなので、ちょっと面白くありません。興味のある方は、解答例のような図を出力するプログラムを作ってみてください。


●プログラムリスト1

(* 
 *  komachi.ml : 小町算の解法
 *
 *               Copyright (C) 2008-2020 Makoto Hiroi
 *)

(* データ型の定義 *)
type term = Plus | Minus | Num of int

(* 式の計算 *)
let calc_expr expr =
  let rec calc_expr_sub expr a =
    match expr with
      [] -> a
    | Plus :: Num x :: xs -> calc_expr_sub xs (a + x)
    | Minus :: Num x :: xs -> calc_expr_sub xs (a - x)
    | _ -> raise (Failure "calc_expr_sub")
  in
    match expr with
      Num x :: xs -> calc_expr_sub xs x
    | _ -> raise (Failure "calc_expr")

(* 式の表示 *)
let rec print_expr = function
  [] -> print_string " = 100\n"
| Num x :: xs -> print_int x; print_expr xs
| Plus :: xs -> print_string " + "; print_expr xs
| Minus :: xs -> print_string " - "; print_expr xs

(* 式の組み立て *)
let rec make_expr n expr =
  if n = 10 then
    let expr1 = List.rev expr in
    if calc_expr expr1 = 100 then print_expr expr1 else ()
  else
    match expr with
      Num x :: xs ->
        make_expr (n + 1) (Num n :: Plus :: expr);
        make_expr (n + 1) (Num n :: Minus :: expr);
        make_expr (n + 1) (Num (x * 10 + n) :: xs)
    | _ -> raise (Failure "make_expr")

●プログラムリスト2

(* 
 *  queen.ml : 8クイーンの解法
 *
 *               Copyright (C) 2008-2020 Makoto Hiroi
 *)

(* 盤面の表示 *)
let rec print_board = function
  [] -> print_newline ()
| x :: xs -> print_int x; print_string " "; print_board xs

(* 要素の削除 *)
let rec remove n xs = List.filter (fun x -> x <> n) xs

(* 衝突の検出 *)
let attack x xs =
  let rec attack_sub x n = function
      [] -> true
    | y :: ys -> if x = y + n || x = y - n then false
                 else attack_sub x (n + 1) ys
  in
    attack_sub x 1 xs

(* 安全確認 *)
let rec safe = function
  [] -> true
| x :: xs -> if attack x xs then safe xs else false

(* 単純な生成検定法 *)
let rec queen f nums board =
  if nums = [] then
    if safe board then f board else ()
  else
    List.iter (fun x -> queen (remove x nums) (x :: board)) nums

(* 高速バージョン *)
let rec queen_fast f nums board =
  if nums = [] then f board
  else List.iter (fun x ->
    if attack x board then queen_fast (remove x nums) (x :: board) else ()) nums

(* 整数列の生成 *)
let rec iota n m =
  if n > m then []
  else n :: iota (n + 1) m

(* 時間計測 *)
let test_queen f n =
  let c = ref 0 in
  let s = Sys.time () in
  f (fun _ -> c := !c + 1) (iota 1 n) [];
  print_float (Sys.time () -. s);
  !c

初版 2008 年 6 月 29 日
改訂 2020 年 7 月 5 日

Copyright (C) 2008-2020 Makoto Hiroi
All rights reserved.

[ PrevPage | OCaml | NextPage ]