Solve the no connection puzzle: Difference between revisions
Rename Perl 6 -> Raku, alphabetize, minor clean-up
Thundergnat (talk | contribs) (Rename Perl 6 -> Raku, alphabetize, minor clean-up) |
|||
Line 56:
[https://www.youtube.com/watch?v=AECElyEyZBQ No Connection Puzzle] (youtube).
<br><br>
=={{header|Ada}}==
This solution is a bit longer than it actually needs to be; however, it uses tasks to find the solution and the used types and solution-generating functions are well-separated, making it more amenable to other solutions or altering it to display all solutions.
Line 306 ⟶ 307:
}
</lang>
=={{header|ARM Assembly}}==
{{works with|as|Raspberry Pi}}
Line 863 ⟶ 865:
</pre>
=={{header|AutoHotkey}}==
Line 1,814 ⟶ 1,815:
\|/ \|/
3 4</lang>
=={{header|Julia}}==
Line 2,142:
56
</pre>
=={{header|Phix}}==
Line 2,727 ⟶ 2,614:
\|/ \|/
5 6</pre>
=={{header|Raku}}==
(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#Perl_6|Solve a Hidato puzzle]]
* [[Solve a Hopido puzzle#Perl_6|Solve a Hopido puzzle]]
* [[Solve a Holy Knight's tour#Perl_6|Solve a Holy Knight's tour]]
* [[Solve a Numbrix puzzle#Perl_6|Solve a Numbrix puzzle]]
* [[Solve the no connection puzzle#Perl_6|Solve the no connection puzzle]]
The idiosyncratic adjacency diagram is dealt with by the simple expedient of bending the two vertical lines <tt>||</tt> into two bows <tt>)(</tt>, such that adjacency can be calculated simply as a distance of 2 or less.
<lang perl6>my @adjacent = gather -> $y, $x {
take [$y,$x] if abs($x|$y) > 2;
} for flat -5 .. 5 X -5 .. 5;
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";
}</lang>
{{out}}
<pre> 4 3
2 8 1 7
6 5
18 tries</pre>
=={{header|REXX}}==
| |||