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]")