nqueens.ml

open List;;

let rec seq n m = if n > m then [] else n :: seq (n + 1) m;;

let rec safe x n = function
    | [] -> true
    | y::ys -> x <> y && x <> y + n && x <> y - n && safe x (n + 1) ys;;

let concmap f xs = concat (map f xs)

let rec foldM f a = function
    | [] -> [a]
    | x::xs -> concmap (fun fa -> foldM f fa xs) (f a x);;

let nqueens n = 
    let safes l = filter (fun m -> safe m 1 l) (seq 1 n) in
    let nqueens' l _ = map (fun x -> x :: l) (safes l) in
    foldM nqueens' [] (seq 1 n);;

let print_solutions size solutions =
 let sol_num = ref 1 in
 iter
   (fun chess ->
     Printf.printf "\nSolution number %i\n" !sol_num;
     sol_num := !sol_num + 1;
     iter
       (fun line ->
         let count = ref 1 in
         while !count <= size do
           if !count = line then print_string "Q " else print_string "- ";
           count := !count + 1
         done;
         print_newline ())
       chess)
   solutions;;

let print_result size =
 let solutions = nqueens size in
 let sol_num = List.length solutions in
 Printf.printf "The %i queens problem has %i solutions.\n" size sol_num;
 print_newline ();
 let pr = 
   print_string "Do you want to see the solutions <n/y> ? "; read_line () in
 if pr = "y" then print_solutions size solutions;;

let result () =
 let size = 
   print_string "Chess boards's size ? "; read_int () in
 print_result size;;

if !Sys.interactive then () else result ();;