
Chess coaches have been known to inflict a kind of torture on beginners by taking a chess board, placing pennies on some squares and requiring that a Knight's tour be constructed that avoids the squares with pennies.

This kind of knight's tour puzzle is similar to   Hidato.

The present task is to produce a solution to such problems. At least demonstrate your program by solving the following:



Example

  0 0 0 
  0   0 0 
  0 0 0 0 0 0 0
0 0 0     0   0
0   0     0 0 0
1 0 0 0 0 0 0
    0 0   0
      0 0 0

Note that the zeros represent the available squares, not the pennies.

Extra credit is available for other interesting examples.



Related tasks

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


my @adjacent =
               [ -2, -1],  [ -2, 1],
      [-1,-2],                       [-1,+2],
      [+1,-2],                       [+1,+2],
               [ +2, -1],  [ +2, 1];
 
put "\n" xx 60;
 
solveboard q:to/END/;
    . 0 0 0
    . 0 . 0 0
    . 0 0 0 0 0 0 0
    0 0 0 . . 0 . 0
    0 . 0 . . 0 0 0
    1 0 0 0 0 0 0
    . . 0 0 . 0
    . . . 0 0 0
    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";
}