5
\$\begingroup\$

Playing with https://ocaml.org/learn/tutorials/99problems.html#Miscellaneous-Problems I wrote a backtracking solver for the n queens problem, then the knight's tour, and realised I could generalise the backtracking algorithm to be shared between both. How's my code? Is is F#-onic? Could any of it be simplified?

  1. Is there a simpler alternative to the match expression in solveByBacktracking?
  2. Can relativeMoves be described more succintly?
  3. Can the prepend function be inlined?

Thanks for reading

// solve a problem by backtracking
let solveByBacktracking moves solved 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

// 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 moves solved

// 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 moves solved
\$\endgroup\$
  • \$\begingroup\$ You might be interested in the following papers: oberoncore.ru/_media/library/… and usi-pl.github.io/lc/sp-2015/doc/… Both these do have a "walkthrough" of the Queens problem, but arrive at two totally different solutions. \$\endgroup\$ – Helge Rene Urholm May 18 '18 at 7:19
  • \$\begingroup\$ Do you have any test cases for this code that you have? (including the expected result). I started trying to simplify this but I don't want to break anything. \$\endgroup\$ – TheQuickBrownFox May 22 '18 at 9:10

Your Answer

By clicking "Post Your Answer", you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.