Eight queens revisited

Jon Harrop spotted that the Ocaml code was calling is_threatened 64515 times compared to the C++ calling is_threatened just 1915 times. I eventually spotted the bug in the C++ code: next_valid_posn was not correctly iterating through the x positions. The fix was straight-forward:

    Posn next_valid_posn(const Posn& p) const {
        for (int y = p.y_; y < size_; y++) {
            int initX = (y == p.y_) ? (p.x_ + 1) : 0;
            for (int x = initX; x < size_; x++) {
                if (ref(x, y) == Safe) { return Posn(x, y); }
            }
        }

        return Posn(-1, -1);
    }

and now the C++ and Ocaml are much more closely matched. The fixed C++ completes 100 solutions in 9.5 seconds and the Ocaml completes 100 solutions in 19.3 seconds.

Andrej Bauer on the Ocaml mailing list came up with an attractive translation from my C++ which duplicates the bug of not covering all of the x positions. I’ve attached it below.

Thanks for the help to everyone on the Ocaml mailing list.

(* Andrej Bauer's solution *)
type square = Qu | Safe | At

(* A board is an array of arrays of squares *)
type board = square array array

type posn = int * int

let string_of_square = function
  | Qu   -> "Qu"
  | Safe -> "#f"
  | At   -> "At"

let init_pos = (0,0)

let get board (x,y) = board.(y).(x)

let display board =
  Array.iter
    (fun row ->
       Array.iter (fun square -> print_string (string_of_square square ^ " ")) row ;
       print_newline ()
    )
    board

let build size f =
  Array.init size (fun y -> Array.init size (fun x -> f (x,y)))

let is_threatened (x1,y1) (x2,y2) =
  x1 = x2 || y1 = y2 || (x2 - x1) = (y2 - y1) || (x1 - y2) = (x2 - y1)

let add_queen board p =
  build
    (Array.length board)
    (fun q ->
       if q = p then
	 Qu
       else
	 match get board q with
	   | Safe when is_threatened q p -> At
	   | square -> square)

exception No_solution

(* This function is the equivalent of Board::placement. *)
let rec solve board p rem =
  let size = Array.length board in
  let next_posn (px,_) (x,y) =
      if x + 1 < size then (x+1, y)
      else if y + 1 < size then (px, y+1)
      else raise No_solution
  in
  let next_valid_posn p =
    let rec loop q =
      match get board q with
	| Safe -> q
	| _ -> loop (next_posn p q)
    in
      loop p
  in
    if rem = 0 then
      board
    else
      let p' = next_valid_posn p in
	try
	  solve (add_queen board p') init_pos (rem-1)
	with No_solution -> solve board (next_posn p p') rem

let main =
  try
    let size = int_of_string Sys.argv.(1) in
    let times = int_of_string Sys.argv.(2) in
    let empty_board = build size (fun _ -> Safe) in
      for i = 2 to times do
	ignore (solve empty_board (0,0) 8 )
      done ;
      display (solve empty_board (0,0) 8 )
  with
    | No_solution -> print_endline "No solution."
    | _ -> print_endline ("Usage: " ^ Sys.argv.(0) ^ " [size] [times]")