let problem =
  """ .  .  4 | 8  .  . | .  1  7  
              |         |          
      6  7  . | 9  .  . | .  .  .  
              |         |          
      5  .  8 | .  3  . | .  .  4  
      --------+---------+--------  
      3  .  . | 7  4  . | 1  .  .  
              |         |          
      .  6  9 | .  .  . | 7  8  .  
              |         |          
      .  .  1 | .  6  9 | .  .  5  
      --------+---------+--------  
      1  .  . | .  8  . | 3  .  6  
              |         |          
      .  .  . | .  .  6 | .  9  1  
              |         |          
      2  4  . | .  .  1 | 5  .  .  
  """

/// Returns all possible positions on a Sudoku board
let positions =
  seq { for x in 0 .. 8 do
          for y in 0 .. 8 do 
            yield x, y }

/// Set of numbers that can appear in a place
let numbers = set [ 1 .. 9 ]

/// Create 2D array containing 'None' for every blank space and
/// 'Some n' for every assigned number. We do this by iterating
/// over lines & over characters and skipping everything that is
/// not '.' or a valid number
let task =
  [ for line in problem.Split('\n') do
      let parsed =
        [ for c in line do
            if c = '.' then yield None
            elif c >= '0' && c <= '9' then yield Some(int c - 48) ] 
      if parsed <> [] then yield parsed ]
  |> array2D

/// We represent the state of the board as a map from indices
/// (this lets us do recursive backtracking nicely)
type Sudoku = Map<int * int, int>

/// Turn the 2D array into a 'Sudoku' value
let state : Sudoku =
  positions |> Seq.choose (fun (x, y) -> 
    task.[x, y] |> Option.map (fun v -> (x, y), v))
  |> Map.ofSeq

/// Returns the first empty position in the game
/// (or 'None' when all the positions are filled)
let findEmpty (state : Sudoku) = 
  positions |> Seq.tryFind (state.ContainsKey >> not)

/// Returns a list with 3 lists that contain positions 
/// on the board that have to be unique (that is, horizontal
/// line, vertical line and the small square)
let findLines (x, y) = 
  let xs, ys = x/3*3, y/3*3
  [ [ for y in 0 .. 8 -> x, y ]
    [ for x in 0 .. 8 -> x, y ]
    [ for x in 0 .. 2 do for y in 0 .. 2 do yield xs + x, ys + y ] ]

/// Find numbers that are not used on a 'line'
let getUnusedOnLine (state:Sudoku) line =   
  numbers - set (line |> Seq.choose state.TryFind)

/// Recursive sudoku solver. Keeps the current state
/// in an immutable map to make backtracking easy
let rec solve (state:Sudoku) =
  match findEmpty state with
  | Some pos -> 
      // If there is an empty place, find all numbers that we can put there
      let alternatives = 
        findLines pos |> Seq.map (getUnusedOnLine state) |> Set.intersectMany
      // Iterate over alternatives, add the number to the current 'pos'
      // and try calling 'solve' recursively for the rest of the board
      alternatives |> Seq.tryPick (fun v ->
        solve (Map.add pos v state))
  | None -> Some(state)

/// Nicely format sudoku board that we get from the solver
let printState (state:Sudoku) =
  let newBlock () =
    [ for i in 0 .. 2 -> String.replicate 9 "-" ]
    |> String.concat "+" |> printfn "+%s+"
  newBlock ()
  for x in 0 .. 8 do 
    printf "|"
    for y in 0 .. 8 do
      match state.TryFind (x, y) with
      | Some v -> printf " %d " v
      | _ -> printf ". "
      if y % 3 = 2 then printf "|"
    printfn ""
    if x % 3 = 2 then newBlock()
    
// Run the solver and print the result!
let solved = solve state
printState solved.Value

// +---------+---------+---------+
// | 9  3  4 | 8  2  5 | 6  1  7 |
// | 6  7  2 | 9  1  4 | 8  5  3 |
// | 5  1  8 | 6  3  7 | 9  2  4 |
// +---------+---------+---------+
// | 3  2  5 | 7  4  8 | 1  6  9 |
// | 4  6  9 | 1  5  3 | 7  8  2 |
// | 7  8  1 | 2  6  9 | 4  3  5 |
// +---------+---------+---------+
// | 1  9  7 | 5  8  2 | 3  4  6 |
// | 8  5  3 | 4  7  6 | 2  9  1 |
// | 2  4  6 | 3  9  1 | 5  7  8 |
// +---------+---------+---------+