○×

久しぶりにOCamlを使ってみたら、全く手が動かなかったのでリハビリをしてみました。題材は○×(マルバツ)。

これまで、ゲームのアルゴリズムらしきものを書いたことが無いので定番のやり方がが分からないのですが、とりあえず全ルートの木を作って勝ち負けの数を加減していけば、それらしく動きそうな気がします。

こんな要素を持つ木にしてみました。

• 位置
• 勝ち負けの数
• 決着がついている場合、その結果
• 次以降の手順（子）

位置情報はどうしようかなぁ… 要素数9の配列で3×3を表現したほうが簡単そうだけど、まじめに3×3の配列で。

とか悩みながらぐちゃぐちゃと書いてみたら以下のようなコードになりました。

(* misc *)
let say comment =
  print_endline comment; print_newline ()

let print_line () =
  print_endline "-------------------------------------------";
  print_newline ()


(* matrix *)
type mode = O | X | I

let string_of_mode = function O -> "O" | X -> "X" | _ -> "I"

let toggle_mode = function 
  O -> X | X -> O | I -> failwith "Error occured in toggle_mode."

let repeat f x n =
  let rec loop x i =
    if n > i then loop (f x i) (i + 1) else x in
  loop x 0

let select f n =
  let rec loop i l =
    if n > i
      then let result = 
             match (f i) with Some x -> x::l | None -> l in
           loop (i + 1) result
      else l in
  loop 0 []

let get_column mtx i =
  Array.to_list (Array.map (fun row -> row.(i)) mtx)

let is_victor mode mtx =
  let is_same_mode l =
    List.for_all (fun e -> e = mode) l in
  List.exists (fun a -> is_same_mode (Array.to_list a)) (Array.to_list mtx)
      || repeat
           (fun x i -> is_same_mode (get_column mtx i) || x)
           false (Array.length  mtx.(0))
      || is_same_mode [mtx.(0).(0); mtx.(1).(1); mtx.(2).(2)]
      || is_same_mode [mtx.(2).(0); mtx.(1).(1); mtx.(0).(2)]

let select_free_from_matrix mtx =
  List.flatten (
    select (fun y -> 
      let l =
        select
          (fun x -> if mtx.(y).(x) = I then Some (y, x) else None)
          (Array.length mtx.(y)) in
      Some l
    ) (Array.length mtx))

let set_postion mtx mode pos = 
  let new_mtx = Array.map (fun row -> Array.copy row) mtx in
  new_mtx.(fst pos).(snd pos) <- mode;
  new_mtx


(* tree *)

(* pos(opt), result, score and children *)
type ('a, 'b, 'c) tree =
  Br of 'a option * 'b * 'c * ('a, 'b, 'c) tree list

let get_pos_from_tree = function
  | Br(Some(pos), _, _, _) -> pos
  | _ -> failwith "Error occured in get_pos_from_tree."

let get_result_from_tree = function Br(_, result, _, _) -> result

let get_score_from_tree = function Br(_, _, score, _) -> score

let get_children_from_tree = function Br(_, _, _, children) -> children

let print_trees trees =
  List.iter
    (fun tr ->
      let (y, x) = get_pos_from_tree tr in
      let r = get_result_from_tree tr in
      let s = get_score_from_tree tr in
      let rs = string_of_mode r in
      Printf.printf "((%d, %d), %s, %d) " y x rs s) trees;
      print_newline ()

let score_tree mode score children =
  List.fold_left
    (fun a b -> 
      let Br(_, r, s, c) = b in
      let point =
        match r with O -> s + 1 | X -> s - 1 | _ -> s in
      let point' =
        if List.exists
             (fun x -> mode = get_result_from_tree x) c
          then 
            match mode with O -> 100 | X -> -100 | _ -> 0
          else 0 in
      a + point + point') score children

let rec find_child_tree mtx mode = function
  | Br(posopt, result, score, children) -> 
    let rec loop frees =
      match frees with
      | [] -> ( (* no free position (back-track) *)
          Br(posopt, result, (score_tree mode score children), children))
      | hd::tl -> 
          if List.exists
               (fun tr -> (get_pos_from_tree tr) = hd)
               children
            then loop tl (* tests next free position *)
            else (       (* new test *)
              let new_mtx = set_postion mtx mode hd in 
              let child_tree =
                if is_victor mode new_mtx 
                  then Br(Some(hd), mode, 0, [])
                  else (
                    find_child_tree new_mtx (toggle_mode mode)
                      (Br(Some(hd), I, 0, [])) 
                  ) in
              find_child_tree mtx mode
                (Br(posopt, result, score, child_tree::children))
            ) in
    loop (select_free_from_matrix mtx)


(* match-up *)
let input_position selectable_postions =
  let rec loop () =
    let inner chr =
      Printf.printf "Please enter your postion %c (0-2) >" chr;
      print_newline ();
      read_int () in
    let y = inner 'y' in
    let x = inner 'x' in
    let pos = (y, x) in
    if List.exists (fun p -> p = pos) selectable_postions
      then pos else (say "You can't select it. Try again.";loop ()) in
  loop ()

let output_position who pos =
  Printf.printf "%s put (y = %d, x = %d)." who (fst pos) (snd pos);
  print_newline ()

let find_victory_postion trees my_mode =
  try Some(List.find
            (fun tr -> (get_result_from_tree tr) = my_mode) trees)
  with Not_found -> None

let find_dangerous_postion trees my_mode =
  let player_mode = toggle_mode my_mode in
  List.filter
    (fun tr -> 
      let children = get_children_from_tree tr in
      List.exists
        (fun tr'->
          let result = get_result_from_tree tr' in
          result = player_mode) children) trees

let get_sorted_position trees my_mode =
  let dangerous_postions = find_dangerous_postion trees my_mode in
  let is_danger tree = 
    List.exists
      (fun tr -> (get_pos_from_tree tree) = (get_pos_from_tree tr))
      dangerous_postions in
  List.sort
  (fun a b -> 
    if is_danger a then 1 else (
      if is_danger b then -1 else (
        let score_a = get_score_from_tree a in
        let score_b = get_score_from_tree b in
        if my_mode = O then score_b - score_a else score_a - score_b
      ))) trees

let player_action player_mode selectable_trees =
  match selectable_trees with
  | [] -> say "This game is draw."; None
  | _ -> (
    print_line ();
    Printf.printf "You can put your piece in these positions(y, x).\n";
    print_trees selectable_trees;
    let player_pos =
      input_position
        (List.map (fun tr -> get_pos_from_tree tr) selectable_trees) in
    output_position "you" player_pos;
    let player_tree =
      List.find
        (fun tr -> (get_pos_from_tree tr) = player_pos)
        selectable_trees in
    if get_result_from_tree player_tree = player_mode
      then (say "You win."; None)
      else Some(player_tree) 
  )

let appl_action my_mode selectable_trees = 
  print_line ();
  Printf.printf "I can put my piece in these positions(y, x).\n";
  print_trees selectable_trees;
  match (find_victory_postion selectable_trees my_mode) with
  | Some(tr) -> 
      output_position "I" (get_pos_from_tree tr);
      say "You Lose."; None
  | None -> (
    match (get_sorted_position selectable_trees my_mode) with
    | [] -> say "This game is draw."; None
    | hd::tl ->
        output_position "I" (get_pos_from_tree hd); Some(hd)) 

let toggle_player_action action = 
  if action == player_action then appl_action else player_action

let fight player_mode trees =
  let rec loop mode action selectable_trees =
    match (action mode selectable_trees) with
    | Some(tr) ->
        loop (toggle_mode mode) (toggle_player_action action) 
             (get_children_from_tree tr) 
    | None -> () in
  if player_mode = O
    then loop player_mode player_action trees
    else loop (toggle_mode player_mode) appl_action trees

let main () =
  let tree =
    find_child_tree
      (Array.create_matrix 3 3 I) O (Br(None, I, 0, [])) in
  let rec choice () = 
    say "Which do you choice O or X ?";
    match read_line () with "O" -> O | "X" -> X | _ -> choice () in
  let rec fight_loop () =
    let player_mode = choice () in
    fight player_mode (get_children_from_tree tree);
    say "Next match...\n\n";
    fight_loop () in
  fight_loop ()

let _ = main ()

何だか長々としたコードになっちゃった… orz。ざっくり書くと、前半が手順の木を作る部分、後半が対戦部分になります。

とりあえず、実行させると木を作りに行くんですが、きちんと末尾再帰になっていないせいか結構時間がかかります。バイトコードだとつらいかも。

あと、単純に勝ち負けの数だけで評価しているのですが、これで良いのか？かなり疑問です。

おまけに、対戦中はそれまでに打った駒に関する情報が表示されません(その時点で打てる場所のみ表示)。これはこれで個人的に面白かったのでそのままに。

ちなみに、今回勉強になったのは「関数同士の比較には(=)でなくて(==)を使うべし」でした。あとは「何だかArray使いづらい」。