4
\$\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 acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.

Browse other questions tagged or ask your own question.