ライフゲームモジュール

練習のため、http://d.hatena.ne.jp/komamitsu/20090326/1238081086をモジュールにしてみた。

lifegame.mli

type cell = N | C
type world
val create_world : cell array array -> world
val make_next_world : world -> world
val disp_world : world -> (cell -> int -> int -> 'a) -> (int -> unit) -> unit

lifegame.ml

type cell = N | C
type world = 
  {matrix:cell array array; x_min:int; x_max:int; y_min:int; y_max:int}

let loop_matrix ~x_low ~x_high ~y_low ~y_high ~init ~f =
  let rec loop_y y result =
    if y > y_high then result
    else 
      let rec loop_x x result =
        if x > x_high then result
        else loop_x (x + 1) (f x y result) in
      loop_y (y + 1) (loop_x x_low result) in
  loop_y y_low init

let get_cell m x y = m.(y).(x)

let set_cell m x y c = m.(y).(x) <- c

let int_of_cell = function C -> 1 | N -> 0

let count_arround_cells w x y =
  let x_low  = if x > w.x_min then x - 1 else x in
  let x_high = if x < w.x_max then x + 1 else x in
  let y_low  = if y > w.y_min then y - 1 else y in
  let y_high = if y < w.y_max then y + 1 else y in
  loop_matrix ~x_low ~x_high ~y_low ~y_high ~init:0
    ~f:(fun x_idx y_idx result ->
          let add_point =
            if x_idx = x && y_idx = y then 0
            else (int_of_cell(get_cell w.matrix x_idx y_idx)) in
          result + add_point)

let next_cell arround_cell_count = function
  | N when arround_cell_count = 3 -> C (* born *)
  | C when arround_cell_count = 2 || 
           arround_cell_count = 3 -> C (* survive *)
  | _ -> N (* death *) 

let create_world src_matrix =
  {matrix = src_matrix;
    x_min = 0; x_max = Array.length src_matrix.(0) - 1;
    y_min = 0; y_max = Array.length src_matrix - 1}

let make_next_world w =
  let next_matrix_empty =
    Array.make_matrix (w.x_max + 1) (w.y_max + 1) N in
  let next_matrix =
    loop_matrix ~init:next_matrix_empty
      ~x_low:w.x_min ~x_high:w.x_max ~y_low:w.y_min ~y_high:w.y_max
      ~f:(fun x y matrix ->
            let cell = get_cell w.matrix x y in
            let cell_count = count_arround_cells w x y in
            set_cell matrix x y (next_cell cell_count cell);
            matrix) in
  create_world next_matrix

let disp_world w func_for_char func_for_line =
  ignore(
    loop_matrix
      ~x_low:w.x_min ~x_high:w.x_max ~y_low:w.y_min
      ~y_high:w.y_max ~init:w
      ~f:(fun x y w ->
          func_for_char (get_cell w.matrix x y) x y;
          if x >= w.x_max then (func_for_line y);
          w)
  )

使い方はこんな感じ.

main.ml

(* ocamlc lifegame.mli
 * ocamlc -c lifegame.ml
 * ocamlc -o lifegame unix.cma lifegame.cmo main.ml
 *)
open Lifegame
open Printf

let orig_matrix = [|
  [|N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;C;N;N|];
  [|N;N;C;N;N;N;N;N;N;N;N;N;N;N;N;N;C;N;N;N|];
  [|N;N;C;N;N;N;N;N;N;N;N;N;N;N;N;N;C;C;C;N|];
  [|N;N;C;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N|];
  [|N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N|];
  [|N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N|];
  [|N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N|];
  [|N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N|];
  [|N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N|];
  [|N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N|];
  [|N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N|];
  [|N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N|];
  [|N;N;N;N;N;N;N;N;N;N;N;N;C;N;N;N;N;N;N;N|];
  [|N;N;N;N;N;N;C;C;N;N;N;N;N;N;N;N;N;N;N;N|];
  [|N;N;N;N;N;N;N;C;N;N;N;C;C;C;N;N;N;N;N;N|];
  [|N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N|];
  [|N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N|];
  [|N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N|];
  [|N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N|];
  [|N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N;N|]
|]

let _ =
  let world = create_world orig_matrix in
  let rec loop world =
    printf "--------------------------------------------\n";
    disp_world world
      (fun cell x y ->
        printf "%c" (if cell = C then '@' else ' '))
      (fun y -> printf "\n");
    flush stdout;
    Unix.sleep 1;
    loop (make_next_world world) in
  loop world

書いていて気になった点は、type cell = N | C というコードが lifegame.mli, lifegame.ml の両方に出てくること。C のヘッダファイルのように *.mli に書いておけば *.ml のコンパイル時にそれを参照できるのかなぁと思っていたのだけど駄目だった。

OCaml-3.10.2 の otherlibs/unix/unix.ml* を見たら、やはり同じ内容が埋め込まれている（type error）ので、そういうもんかなぁと諦めた。ちょっと残念。