user
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

Sample Hidato problem, from Wikipedia

has the following solution, with path marked on it:

Solution to sample Hidato problem

Related tasks

* A\* search algorithm
* N-queens problem
* Solve a Holy Knight's tour
* Knight's tour
* Solve a Hopido puzzle
* Solve a Numbrix puzzle
* Solve the no connection puzzle;
assistant
(formerly Perl 6)

This uses a Warnsdorff solver, which cuts down the number of tries by more than a factor of six over the brute force approach. This same solver is used in:

* Solve a Hidato puzzle
* Solve a Hopido puzzle
* Solve a Holy Knight's tour
* Solve a Numbrix puzzle
* Solve the no connection puzzle

```
my @adjacent = [-1, -1], [-1, 0], [-1, 1],
               [ 0, -1],          [ 0, 1],
               [ 1, -1], [ 1, 0], [ 1, 1];

solveboard q:to/END/;
        __ 33 35 __ __ .. .. ..
        __ __ 24 22 __ .. .. ..
        __ __ __ 21 __ __ .. ..
        __ 26 __ 13 40 11 .. ..
        27 __ __ __  9 __  1 ..
        .. .. __ __ 18 __ __ ..
        .. .. .. .. __  7 __ __
        .. .. .. .. .. ..  5 __
        END
 
sub solveboard($board) {
    my $max = +$board.comb(/\w+/);
    my $width = $max.chars;

    my @grid;
    my @known;
    my @neigh;
    my @degree;
 
    @grid = $board.lines.map: -> $line {
        [ $line.words.map: { /^_/ ?? 0 !! /^\./ ?? Rat !! $_ } ]
    }
 
    sub neighbors($y,$x --> List) {
        eager gather for @adjacent {
            my $y1 = $y + .[0];
            my $x1 = $x + .[1];
            take [$y1,$x1] if defined @grid[$y1][$x1];
        }
    }

    for ^@grid -> $y {
        for ^@grid[$y] -> $x {
            if @grid[$y][$x] -> $v {
                @known[$v] = [$y,$x];
            }
            if @grid[$y][$x].defined {
                @neigh[$y][$x] = neighbors($y,$x);
                @degree[$y][$x] = +@neigh[$y][$x];
            }
        }
    }
    print "\e[0H\e[0J";

    my $tries = 0;

    try_fill 1, @known[1];

    sub try_fill($v, $coord [$y,$x] --> Bool) {
        return True if $v > $max;
        $tries++;

        my $old = @grid[$y][$x];

        return False if +$old and $old != $v;
        return False if @known[$v] and @known[$v] !eqv $coord;

        @grid[$y][$x] = $v;               # conjecture grid value

        print "\e[0H";                    # show conjectured board
        for @grid -> $r {
            say do for @$r {
                when Rat { ' ' x $width }
                when 0   { '_' x $width }
                default  { .fmt("%{$width}d") }
            }
        }


        my @neighbors = @neigh[$y][$x][];

        my @degrees;
        for @neighbors -> \n [$yy,$xx] {
            my $d = --@degree[$yy][$xx];  # conjecture new degrees
            push @degrees[$d], n;         # and categorize by degree
        }

        for @degrees.grep(*.defined) -> @ties {
            for @ties.reverse {           # reverse works better for this hidato anyway
                return True if try_fill $v + 1, $_;
            }
        }

        for @neighbors -> [$yy,$xx] {
            ++@degree[$yy][$xx];          # undo degree conjectures
        }

        @grid[$y][$x] = $old;             # undo grid value conjecture
        return False;
    }
     
    say "$tries tries";
}

```