The task is to write a program which solves Hidato (aka Hidoku) puzzles.

The rules are:

 You are given a grid with some numbers placed in it. The other squares in the grid will be blank.
 The grid is not necessarily rectangular.
 The grid may have holes in it.
 The grid is always connected.
 The number “1” is always present, as is another number that is equal to the number of squares in the grid. Other numbers are present so as to force the solution to be unique.
 It may be assumed that the difference between numbers present on the grid is not greater than lucky 13.
 The aim is to place a natural number in each blank square so that in the sequence of numbered squares from “1” upwards, each square is in the wp:Moore neighborhood of the squares immediately before and after it in the sequence (except for the first and last squares, of course, which only have one-sided constraints).
 Thus, if the grid was overlaid on a chessboard, a king would be able to make legal moves along the path from first to last square in numerical order.
 A square may only contain one number.
 In a proper Hidato puzzle, the solution is unique.

For example the following problem


has the following solution, with path marked on it:




Related tasks

 A* search algorithm
 N-queens problem
 Solve a Holy Knight's tour
 Solve a Knight's tour
 Solve a Hopido puzzle
 Solve a Numbrix puzzle
 Solve the no connection puzzle;


$ include "seed7_05.s7i";
 
var set of integer: given is {};
var array array integer: board is 0 times 0 times 0;
var integer: startRow is 0;
var integer: startColumn is 0;
 
const proc: setup (in array string: input) is func
  local
    var integer: r is 0;
    var integer: c is 0;
    var array string: row is 0 times "";
    var string: cell is "";
    var integer: value is 0;
  begin
    board := (length(input) + 2) times 0 times 0;
    for key r range input do
      row := split(input[r], " ");
      board[r + 1] := (length(row) + 2) times - 1;
      for key c range row do
        cell := row[c];
        if cell = "_" then
          board[r + 1][c + 1] := 0;
        elsif cell[1] in {'0' .. '9'} then
          value := integer parse cell;
          board[r + 1][c + 1] := value;
          incl(given, value);
          if value = 1 then
            startRow := r + 1;
            startColumn := c + 1;
          end if;
        end if;
      end for;
    end for;
    board[1] := (length(row) + 2) times - 1;
    board[length(input) + 2] := (length(row) + 2) times - 1;
  end func;
 
const func boolean: solve (in integer: r, in integer: c, in integer: n) is func
  result
    var boolean: solved is FALSE;
  local
    var integer: back is 0;
    var integer: i is 0;
    var integer: j is 0;
  begin
    if n > max(given) then
      solved := TRUE;
    elsif board[r][c] = 0 and n not in given or board[r][c] = n then
      back := board[r][c];
      board[r][c] := n;
      for i range -1 to 1 until solved do
        for j range -1 to 1 until solved do
          solved := solve(r + i, c + j, n + 1);
        end for;
      end for;
      if not solved then
        board[r][c] := back;
      end if;
    end if;
  end func;
 
const proc: printBoard is func
  local
    var integer: r is 0;
    var integer: c is 0;
  begin
    for key r range board do
      for c range board[r] do
        if c = -1 then
          write(" . ");
        elsif c > 0 then
          write(c lpad 2 <& " ");
        else
          write("__ ");
        end if;
      end for;
      writeln;
    end for;
  end func;
 
const proc: main is func
  local
    const array string: input is [] ("_ 33 35 _ _ . . .",
                                     "_ _ 24 22 _ . . .",
                                     "_ _ _ 21 _ _ . .",
                                     "_ 26 _ 13 40 11 . .",
                                     "27 _ _ _ 9 _ 1 .",
                                     ". . _ _ 18 _ _ .",
                                     ". . . . _ 7 _ _",
                                     ". . . . . . 5 _");
  begin
    setup(input);
    printBoard;
    writeln;
    if solve(startRow, startColumn, 1) then
      writeln("Found:");
      printBoard;
    end if;
  end func;