June 2018 Update

Task/Solve-a-Hopido-puzzle/Kotlin/solve-a-hopido-puzzle.kotlin

@@ -0,0 +1,96 @@
+// version 1.2.0
+
+val board = listOf(
+    ".00.00.",
+    "0000000",
+    "0000000",
+    ".00000.",
+    "..000..",
+    "...0..."
+)
+
+val moves = listOf(
+    -3 to 0, 0 to  3,  3 to 0,  0 to -3,
+     2 to 2, 2 to -2, -2 to 2, -2 to -2
+)
+
+lateinit var grid: List<IntArray>
+var totalToFill = 0
+
+fun solve(r: Int, c: Int, count: Int): Boolean {
+    if (count > totalToFill) return true
+    val nbrs = neighbors(r, c)
+    if (nbrs.isEmpty() && count != totalToFill) return false
+    nbrs.sortBy { it[2] }
+    for (nb in nbrs) {
+        val rr = nb[0]
+        val cc = nb[1]
+        grid[rr][cc] = count
+        if (solve(rr, cc, count + 1)) return true
+        grid[rr][cc] = 0
+    }
+    return false
+}
+
+fun neighbors(r: Int, c: Int): MutableList<IntArray> {
+    val nbrs = mutableListOf<IntArray>()
+    for (m in moves) {
+        val x = m.first
+        val y = m.second
+        if (grid[r + y][c + x] == 0) {
+            val num = countNeighbors(r + y, c + x) - 1
+            nbrs.add(intArrayOf(r + y, c + x, num))
+        }
+    }
+    return nbrs
+}
+
+fun countNeighbors(r: Int, c: Int): Int {
+    var num = 0
+    for (m in moves)
+        if (grid[r + m.second][c + m.first] == 0) num++
+    return num
+}
+
+fun printResult() {
+    for (row in grid) {
+        for (i in row) {
+            print(if (i == -1) "   " else "%2d ".format(i))
+        }
+        println()
+    }
+}
+
+fun main(args: Array<String>) {
+    val nRows = board.size + 6
+    val nCols = board[0].length + 6
+    grid = List(nRows) { IntArray(nCols) { -1} }
+    for (r in 0 until nRows) {
+        for (c in 3 until nCols - 3) {
+            if (r in 3 until nRows - 3) {
+                if (board[r - 3][c - 3] == '0') {
+                    grid[r][c] = 0
+                    totalToFill++
+                }
+            }
+        }
+    }
+    var pos = -1
+    var rr: Int
+    var cc: Int
+    do {
+        do {
+            pos++
+            rr = pos / nCols
+            cc = pos % nCols
+        }
+        while (grid[rr][cc] == -1)
+
+        grid[rr][cc] = 1
+        if (solve(rr, cc, 2)) break
+        grid[rr][cc] = 0
+    }
+    while (pos < nRows * nCols)
+
+    printResult()
+}

Task/Solve-a-Hopido-puzzle/Perl-6/solve-a-hopido-puzzle.pl6

@@ -12,3 +12,87 @@ solveboard q:to/END/;
     . . _ _ _ . .
     . . . 1 . . .
     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";
+}