knights2.fs

// solve a problem by backtracking
let solveByBacktracking solved moves initialState = 
    let rec inner state = 
        // to do: backtrack immediately if arrive at state we've seen before. (This can't happen for knight's tour or n queens as below.)
        match state with
            | Some progress when (progress |> solved |> not) ->
                progress |> moves |> Seq.map (Some >> inner) |> Seq.tryFind Option.isSome |> Option.flatten
            | _ -> state
    initialState |> Some |> inner

// search for an example of knight's tour on n by m board
let knightsTour (n,m) = 
    let solved progress = (List.length progress) = n*m
    let moves progress = 
        match progress with 
        | [] -> 
            seq {for i in [0..n-1] do for j in [0..m-1] do yield [(i, j)]}
        | (i, j)::_ ->
            let onBoard (i,j) = 
                0 <= i && i < n && 0 <= j && j < m
            let relativeMoves = [(1,2); (1,-2); (2,1); (2,-1); (-1, 2); (-1, -2); (-2, 1); (-2, -1)]
            let prepend pos = pos :: progress
            let novel pos = progress |> List.contains pos |> not
            relativeMoves |> Seq.map (fun (x,y) -> (x+i, y+j)) |> Seq.filter onBoard |> Seq.filter novel |> Seq.map prepend
    [] |> solveByBacktracking solved moves

// solve n queens problem. place n queens on an n x n board such that none threaten each other. returns row of each queen by column.
let queens n =
    let legal rows =
        // check that no queens are threatening each other
        let n = rows |> Seq.length
        let areDistinct = Seq.distinct >> Seq.length >> (=) n
        let forwardDiagonals = rows |> Seq.mapi (+)
        let backDiagonals = rows |> Seq.mapi (-)
        rows |> areDistinct && forwardDiagonals |> areDistinct && backDiagonals |> areDistinct
    let solved progress = (List.length progress) = n
    let moves progress = 
        let prepend x = x::progress
        [0..n-1] |> Seq.map prepend |> Seq.filter legal
    [] |> solveByBacktracking solved moves