N-Queens Puzzle

Question

The N-Queens puzzle can be solved in many ways. One is by a depth-first-search backtracking algorithm.

Below is my generalized version using mutual recursion:

let dfsBacktrack initialValue solved getNextItems = 

    let rec procCurrent path =
        match solved path with
        | true -> Some path
        | false -> procNext path (getNextItems path) 

    and procNext path nextItems =
        match nextItems with
        | [] -> None
        | next::tail ->
            match procCurrent (next::path) with
            | Some solution -> Some solution
            | None -> procNext path tail

    procCurrent [ initialValue ]

The main problem with it is that it is not tail recursive so it builds up the stack with the limitations that leads to.

Anyway solving the N-Queens problem with it could look like:

let queensProblem n = 
    if n < 4 then failwith "n must be greater than or equal to 4"

    let solved queens = queens |> List.length = n

    let getFields row = [0..n-1] |> List.map (fun col -> col, row)

    let isValidField (col, row) (qcol, qrow) = 
        col <> qcol && row <> qrow // horz and vert
        && abs (col - qcol) <> abs (row - qrow) // diagonals

    let reduceByQueen fields queen =
        fields
        |> List.where (fun pos -> isValidField pos queen)

    let getValidFields queens = 
        let row = queens |> List.head |> (snd)
        queens
        |> List.fold reduceByQueen (getFields (row + 1))

    dfsBacktrack (0, 0) solved getValidFields |> Option.get |> List.rev

For n < 27 it finds a solution fairly quickly.

For n = 8 it produces the output: [(0, 0); (4, 1); (7, 2); (5, 3); (2, 4); (6, 5); (1, 6); (3, 7)]

The above algorithm can also be used to find a solution for the Knight's Tour-problem:

let knightsTour n = 
    if n < 5 then failwith "n must be greater than or equal to 5"

    let solved positions = positions |> List.length = n*n
    let onboard (x, y) = x >= 0 && x < n && y >= 0 && y < n
    let offsets = [ (2, 1); (2, -1); (1, 2); (1, -2); (-1, 2); (-1, -2); (-2, 1); (-2, -1) ]
    let offset (x, y) (dx, dy) = x + dx, y + dy

    let nextPositions path = 
        let pos = path |> List.head
        let rec collect pos path recall = 
            let posses = 
                offsets 
                |> List.map (fun o -> offset pos o)
                |> List.where (fun p -> onboard p && not (path |> List.contains p))

            // Warnsdorff's rule
            match recall with
            | true -> 
                posses
                |> List.map (fun pt -> pt, collect pt (pt::path) false |> List.length)
                |> List.sortBy (fun (_, count) -> count)
                |> List.map (fun (pt, _) -> pt)
            | false -> posses

        collect pos path true

    dfsBacktrack (0, 0) solved nextPositions 

---

Another algorithm for the N-Queens problem is the Min-conflicts algorithm, which shows to be much more efficient:

let queensProblemByMinConflicts maxIterations n =
    if n < 4 then failwith "n must be greater than or equal to 4"

    let rand = Random(5)

    let initQueens = 
        Array.init n id 
        |> Array.map (fun i -> i, (i * 2) % n) // map (fun i -> i, rand.Next() % n)  //

    let hasConflict (q1c, q1r) (q2c, q2r) = q1c = q2c || q1r = q2r || abs (q1c - q2c) = abs (q1r - q2r)

    let getConflicts queen queens = 
        let conflicts = 
            queens 
            |> Array.where (fun q -> q <> queen && hasConflict queen q)

        match conflicts with
        | [||] -> None
        | arr -> Some (arr)

    let countConflicts queen queens = 
        match getConflicts queen queens with
        | None -> 0
        | Some conflicts -> conflicts |> Array.length

    let indicesWithConflicts queens = 
        queens 
        |> Array.mapi (fun i q -> (i, q))
        |> Array.where (fun (_, q) -> countConflicts q queens > 0)
        |> Array.map (fst)

    let minimizeConflicts (qc, qr) queens = 
        [| 0..n-1 |]
        |> Array.where (fun r -> r <> qr)
        |> Array.map (fun r -> (qc, r))
        |> Array.groupBy (fun q -> countConflicts q queens)
        |> Array.sortBy (fun (k, _) -> k)
        |> Array.head 
        |> fun (_, qs) -> qs.[rand.Next(0, qs |> Array.length)]

    let rec nextState queens iteration =
        match indicesWithConflicts queens with
        | [||] -> Some queens
        | conflicts -> 
            match iteration with
            | _ when iteration = maxIterations -> None
            | _ -> 
                let curQueenIndex = conflicts.[rand.Next(0, conflicts |> Array.length)]
                let curQueen = minimizeConflicts queens.[curQueenIndex] queens
                queens.[curQueenIndex] <- curQueen
                nextState queens (iteration + 1)

    nextState initQueens 0

From an initial full - most likely invalid - configuration of N queens on the board (one queen per column), it recursively chooses randomly a queen with conflicts and positions that in its column on a field with the smallest number of conflicts. If more fields have the same smallest number of conflicts one is randomly chosen among them. In the above algorithm maxIterations makes it possible to return with no valid solution found instead of just continue infinitely. nextState is tail recursive.

With let rand = Random(5) and n = 8 the following result is produced:

[|(0, 4); (1, 1); (2, 3); (3, 5); (4, 7); (5, 2); (6, 0); (7, 6)|]

---

I'm interested in any comment, but improvements of and tips about the use of F# as a language are very welcome.