(very long) development styles

[Sami Mäkelä]

Here is a solution (I hope) in mostly functional style using O'Caml. It 
was very hard for me to find a way to solve the problem, but FP helped 
to write the code easily. I think there must be a faster and
more complete solution. (How good the SELF solution is?) I'd also like
to know if the problem can be solved using constraint programming.

------------------------------------------------------------------

(* First I defined the board as an ADT. It shouldn't be possible to make
   illegal moves or have a board at bad state. *)
module Board : sig

  type location
  type move
  type board

  val start : board
  val possible_moves : location -> board -> move list
  val do_move : move -> board -> board
  val buttons : board -> int
  val empty_nodes : board -> location list
  val print_board : board -> unit

end = struct

  (* The structure of the board. *)
  let structure =
   [|
     (* row 1 *) (2, 3);
     (* row 2 *) (2, 3);
     (* row 3 *) (0, 7);
     (* row 4 *) (0, 7);
     (* row 5 *) (0, 7);
     (* row 6 *) (2, 3);
     (* row 7 *) (2, 3);
   |]

  type location = int * int
  type move = location * (location -> location)

  (* State of the board is the list of empty locations. *)
  type board = location list

  (* An optimized List.mem. *)
  let rec mmem ((x,y):int*int) = function
   | [] -> false
   | (x1,y1)::tl -> if x = x1 & y = y1 then true else mmem (x,y) tl

  (* All the holes on the board. *)
  let all_locs =
    let lst = ref [] in
    for i = 0 to Array.length structure - 1 do
      let (a,b) = structure.(i) in
      for j = a to a + b - 1 do
        lst := (i,j) :: !lst
      done
    done;
    !lst

  (* How many holes there are. *)
  let holes = List.length all_locs

  (* Print the board. *)
  let print_board board =
    for i = 0 to Array.length structure - 1 do
      let (a,b) = structure.(i) in
      if a <> 0 then print_string (String.make a ' ');
      for j = a to a + b - 1 do
        if mmem (i,j) board then print_string "."
	else print_string "X"
      done;
      print_string "\n"
    done

  (* Test if a location has a hole. *) 
  let at_board (x,y) =
    if y < 0 or y >= Array.length structure then false else
    let (a,b) = structure.(y) in
    if x < a or x >= a+b then false else true

  (* The directions. *)
  let right (x,y) = (x+1,y)
  let left (x,y) = (x-1,y)
  let down (x,y) = (x,y+1)
  let up (x,y) = (x,y-1)

  (* Check what moves can be done into a hole. *)
  let possible_moves loc board =
    let try_move moves move =
      let m1 = move loc in
      let m2 = move m1 in
      if at_board m2 & not (mmem m2 board) & not (mmem m1 board) then
         (loc, move) :: moves else moves in
    List.fold_left try_move [] [left;up;right;down]

  (* Make a move at the board. *)
  let do_move (loc, move) board =
    move loc :: move (move loc) :: List.filter (fun k -> k <> loc) board

  (* How many buttons left. *)
  let buttons board = holes - List.length board

  (* Empty holes at the board. *)
  let empty_nodes board = board

  (* The start state. *)
  let start = [3,3]

end

(* Return all moves that can be made on the board. *)
let find_moves board =
  let get_moves loc = Board.possible_moves loc board in
  List.flatten (List.map get_moves (Board.empty_nodes board))

(* First I implemented a simple exhaustive search, it would take a very long
   time to find a solution with this (I think it is about as inefficient
   as a straighforward PROLOG solution). *)
let rec dfs_search_board choices path board =
  if Board.buttons board = 1 then board :: path else
  let get_choice () =
   match choices with
   | [] -> raise Not_found
   | (move,board,path) :: b ->
      dfs_search_board b (board::path) (Board.do_move move board) in
  match find_moves board with
  | [] -> get_choice ()
  | [move] -> dfs_search_board choices (board::path) (Board.do_move move board)
  | move :: tl ->
     let new_choices = List.map (fun a -> (a,board,path)) tl @ choices in
     dfs_search_board new_choices (board::path) (Board.do_move move board)

(* Next I added some randomization to the search, but it still couldn't find
   solutions, it was able to find solutions that had two buttons left though.
   *)

(* Count how many moves can be made on a board. *)
let count_moves board = List.length (find_moves board)

(* Return a random item from a list. *)
let get_one_random lst =
  let nth = Random.int (List.length lst) in
  let rec split_nth x = function
   | (a::b) -> if x = nth then a else split_nth (x+1) b in
  split_nth 0 lst

(* Then I realized that there is more likely a better solution if
   there are more possible moves left. It should take about a minute to find a
   solution with this tactic. *)
let rec open_most_moves path board =
  if Board.buttons board < 10 then dfs_search_board [] path board else
  match find_moves board with
  | [] -> raise Not_found
  | hmove :: tl ->
     let get_best (a,moves) move =
       let num = count_moves (Board.do_move move board) in
       if a = num then (a, move::moves) else
       if num > a then (num, [move]) else (a,moves) in
     let _, lst = List.fold_left
       get_best (count_moves (Board.do_move hmove board),[hmove]) tl in
     let move = get_one_random lst in
     open_most_moves (board::path) (Board.do_move move board)

(* Main program. *)
let _ =
  Random.self_init ();
  while true do
    try
      let res = open_most_moves [] Board.start in
      List.iter (fun b -> Board.print_board b; print_string "\n") res;
      flush stdout;
      exit 0
    with Not_found -> ()
  done