June 2018 Update

Task/Solve-the-no-connection-puzzle/Kotlin/solve-the-no-connection-puzzle.kotlin

@@ -0,0 +1,84 @@
+// version 1.2.0
+
+import kotlin.math.abs
+
+// Holes A=0, B=1, …, H=7
+// With connections:
+const val conn = """
+       A   B
+      /|\ /|\
+     / | X | \
+    /  |/ \|  \
+   C - D - E - F
+    \  |\ /|  /
+     \ | X | /
+      \|/ \|/
+       G   H
+"""
+
+val connections = listOf(
+    0 to 2, 0 to 3, 0 to 4,   // A to C, D, E
+    1 to 3, 1 to 4, 1 to 5,   // B to D, E, F
+    6 to 2, 6 to 3, 6 to 4,   // G to C, D, E
+    7 to 3, 7 to 4, 7 to 5,   // H to D, E, F
+    2 to 3, 3 to 4, 4 to 5    // C-D, D-E, E-F
+)
+
+// 'isValid' checks if the pegs are a valid solution.
+// If the absolute difference between any pair of connected pegs is
+// greater than one it is a valid solution.
+fun isValid(pegs: IntArray): Boolean {
+   for ((a, b) in connections) {
+       if (abs(pegs[a] - pegs[b]) <= 1) return false
+   }
+   return true
+}
+
+fun swap(pegs: IntArray, i: Int, j: Int) {
+    val tmp = pegs[i]
+    pegs[i] = pegs[j]
+    pegs[j] = tmp
+}
+
+// 'solve' is a simple recursive brute force solver,
+// it stops at the first found solution.
+// It returns the solution, the number of positions tested,
+// and the number of pegs swapped.
+
+fun solve(): Triple<IntArray, Int, Int> {
+    val pegs = IntArray(8) { it + 1 }
+    var tests = 0
+    var swaps = 0
+
+    fun recurse(i: Int): Boolean {
+        if (i >= pegs.size - 1) {
+            tests++
+            return isValid(pegs)
+        }
+        // Try each remaining peg from pegs[i] onwards
+        for (j in i until pegs.size) {
+            swaps++
+            swap(pegs, i, j)
+            if (recurse(i + 1)) return true
+            swap(pegs, i, j)
+        }
+        return false
+    }
+
+    recurse(0)
+    return Triple(pegs, tests, swaps)
+}
+
+fun pegsAsString(pegs: IntArray): String {
+    val ca = conn.toCharArray()
+    for ((i, c) in ca.withIndex()) {
+        if (c in 'A'..'H') ca[i] = '0' + pegs[c - 'A']
+    }
+    return String(ca)
+}
+
+fun main(args: Array<String>) {
+    val (p, tests, swaps) = solve()
+    println(pegsAsString(p))
+    println("Tested $tests positions and did $swaps swaps.")
+}

Task/Solve-the-no-connection-puzzle/Perl-6/solve-the-no-connection-puzzle.pl6

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