ライフゲーム

前々から気になっていたので、それらしいのを書いてみた。描画は手抜きでprintf。

(* ocamlfind c -package unix -linkpkg -o lifegame lifegame.ml *)
open Printf

let orig_world = [|
    [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0|];
    [|0;0;1;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0|];
    [|0;0;1;0;0;0;0;0;0;0;0;0;0;0;0;0;1;1;1;0|];
    [|0;0;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
    [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
    [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
    [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
    [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
    [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
    [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
    [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
    [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
    [|0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0|];
    [|0;0;0;0;0;0;1;1;0;0;0;0;0;0;0;0;0;0;0;0|];
    [|0;0;0;0;0;0;0;1;0;0;0;1;1;1;0;0;0;0;0;0|];
    [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
    [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
    [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
    [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
    [|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]
|]

let x_min = 0
let x_max = Array.length orig_world.(0) - 1
let y_min = 0
let y_max = Array.length orig_world - 1

let get_cell a x y = a.(y).(x)
let set_cell a x y v = a.(y).(x) <- v

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 count_arround_cells world x y =
  let x_low  = if x > x_min then x - 1 else x in
  let x_high = if x < x_max then x + 1 else x in
  let y_low  = if y > y_min then y - 1 else y in
  let y_high = if y < 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 (get_cell world x_idx y_idx) in
          result + add_point)

let make_next_world world =
  let next_world = Array.make_matrix (x_max + 1) (y_max + 1) 0 in
  loop_matrix 
    ~x_low:x_min ~x_high:x_max ~y_low:y_min ~y_high:y_max ~init:next_world
    ~f:(fun x y next_world ->
          let cell = get_cell world x y in
          let cell_count = count_arround_cells world x y in
          let next_cell =
            match cell with
            | 0 when cell_count = 3 -> 1 (* born *)
            | 1 when cell_count = 2 || cell_count = 3 -> 1 (* survive *)
            | _ -> 0 (* death *) in
          set_cell next_world x y next_cell; 
          next_world)

let disp_world world =
  ignore(
    loop_matrix 
      ~x_low:x_min ~x_high:x_max ~y_low:y_min ~y_high:y_max ~init:world
      ~f:(fun x y world -> 
            let mark = if (get_cell world x y) = 1 then '@' else ' ' in
            printf "%c" mark;
            if x >= x_max then printf "\n"; world)
  );
  flush stdout

let _ =
  let rec loop world =
    disp_world world;
    printf "----------------------------------\n";
    Unix.sleep 1;
    loop (make_next_world world) in
  loop orig_world

おお、いちおう動いているっぽい。楽しいなぁ。

ちなみに、ブリンカーとグライダーとダイハードが配置済み。