This post is part of a series on Mohammad Anwar’s excellent Weekly Challenge, where hackers submit solutions in Perl, Raku, or any other language, to two different challenges every week. (It’s a lot of fun, if you’re into that sort of thing.)
Challenge #1 this week (43) is a number puzzle. In short, the task is to fill in the numbers 1, 2, 3, 4, and 6 into the spaces within the intersecting Olympic rings, so that the numbers in each ring sum to 11. Some of the spaces are already filled in (given). Here is the starting point:
I was able to solve this just by staring at it for a few seconds, so I knew this wasn’t going to be a computationally intensive task. And so instead I wrote a console program that draws the rings and animates every step of the recursive backtracking algorithm I used, because why not.
Drawing and rendering
The full program is nearly 200 lines long, but a large majority of that is for the on-screen drawing and rendering, including an implementation of the midpoint circle algorithm to draw the circles you see at any radius, and any aspect ratio (0.66 gives approximately round circles, with my terminal font). I won’t be going over the drawing and rendering code in detail, since it’s tangential to the challenge and it has been a busy week for me as it is. At a very high level, though, I use a “bitmap” array of arrays (AoA), where the character at any location will correspond to its color. The bitmap for the above image would look like this:
rrrrrrr kkkkkkk bbbbbbb
rrr rrr kkk kkk bbb bbb
r r k k b b
rr rr kk kk bb bb
r r k k b b
r r k k b b
r r k k b b
r <9> ggggkgg {?} yyyybyy <8> b
r ggg r k ggg yyy k b yyy b
r g r k g y k b y b
rr gg{?} rr kk {?}gg yy{?} kk bb {?}yy bb
r g r k g y k b y b
rrr g rrr kkk g y kkk bbb y bbb
rrrrgrr kkkkykk bbbbbbb
g <5> g y <7> y
g g y y
g g y y
gg gg yy yy
g g y y
ggg ggg yyy yyy
ggggggg yyyyyyy
The render pass just takes the bitmap and runs it through a regex to wrap consecutive sequences of the same letter with ANSI escape codes for that color, and I also convert the color to a “pixel” character, #.
The numbers are handled a little differently; they’re looked at in groups of 3 characters: <n> for givens, {n} for candidate numbers, and [n] for solved numbers. That is just to hint the coloring; they’re all rendered in square brackets, just in different colors.
There is plenty of room for improvement with the drawing code. For example, the beginnings of dynamic scaling options are there, but I ended up choosing static sizes and positions for everything. I did not set out to re-invent ncurses.
Backtracking algorithm
I decided to solve the puzzle using a recursive backtracking algorithm.
First, here’s one way to check whether we have a complete, valid solution. The first argument, $_[0] is a hash reference to the %sol variable that might look like %sol = ( rg => 2, gk => 4, ... ).
sub solved {
all { 11 == sum map { $_[0]->{$_} // $given{$_} } split /\+/ }
qw<r+rg rg+g+gk gk+k+ky ky+y+yb yb+b>;
}
That just ensures that every pair (or triple) set of numbers in a ring adds up to 11.
Using that, I started with a basic solve() routine, modified a bit to remove the rendering at each step. Note that @order_try is simply a left-to-right ordering of spots to try. Here is the solver:
sub solve {
my (%sol) = @_;
return %sol if solved(\%sol);
# Get list of numbers still available
my %solR = reverse %sol; # keys <-> values
my @rem = grep { not exists $solR{$_} } @avail;
my $spot = first { $sol{$_} == 0 } @order_try;
for my $num (@rem) {
my %new = solve(%sol, $spot => $num);
return %new if keys %new; # Pass back solution
}
return;
}
That returns a result after 113 iterations, which is not bad, but can be significantly improved by pruning early if we know our partial solution will lead to an impossible solve. Impossible solutions happen when one of the rings has all its values filled, but has a sum other than 11.
So instead of a binary solved() routine, let’s instead use a ternary routine that can distinguish between solved, impossible, and possible results:
# Check a solution. Three possibilities:
# solved: This is a valid solution
# impossible: Solution has at least one sum != 11, so we can prune here
# possible: Solution contains only unknowns or sums == 11
sub check_sol {
my $sol = shift;
my @sums = map {
sum map {
$sol->{$_} || $given{$_} || -100;
} split /\+/;
} qw<r+rg rg+g+gk gk+k+ky ky+y+yb yb+b>;
return (all { $_ == 11 } @sums) ? 'solved'
: (notall { $_ == 11 || $_ < 0 } @sums) ? 'impossible'
: 'possible';
}
You’ll note the logic is very similar to solved(), above. In fact, it’s the result of hacking solved() until it did what I wanted. With this new tool at our disposal, a simple modification to the solve() routine will allow us to return early if a partial solution is impossible. Instead of return %sol if solved(\%sol), we do this:
my $check = check_sol(\%sol);
return %sol if $check eq 'solved';
return if $check eq 'impossible';
And that takes this problem from 113 iterations down to just 16. I’m sure I could crank it down even further, but that would require a lot more effort for negligible benefit.
Raku
In Raku, I just wrote a solver, not a work of ANSI art. I used the same backtracking algorithm, but the code is expressively compact and Raku-ish. The solver becomes:
sub solve( Hash $sol = { } ) {
given check-sol( $sol ) {
return $sol when 'solved';
return when 'impossible';
}
# List of numbers still available
my $rem = $avail ∖ $sol.values;
my $spot = @order.first({ !$sol{$_} });
for $rem.keys.sort -> $num {
return $_ if .defined given solve($sol.clone.append($spot, $num));
}
}
Structurally, this is similar to the Perl routine, but there are some differences. I’m using given/when to topicalize the result of check-sol(), so I don’t need a temp variable. I use the (-) or ∖ set difference operator (that’s U+2216, not a backslash!) to get a list of numbers from $avail that are not found in $sol.values. And finally I again use given to topicalize a result that I use twice.
The check-sol() routine is again a close analog of the Perl version. (This is why in any given week I try to randomize whether I write the Perl version first or the Raku version first!)
sub check-sol( %sol ) {
my @rings = <r+rg rg+g+gk gk+k+ky ky+y+yb yb+b>;
my @sums = @rings.map({
.split('+').map({ %sol{$_} || %given{$_} || -∞ }).sum;
});
return 'solved' if @sums.all == 11;
return 'impossible' if @sums.grep({ $_ ≠ 11 and $_ > 0 });
return 'possible';
}
In this Raku version, I use -∞ as a better sentinel value, because no matter what gets added to it, it will still be negative infinity.
The @sums.all == 11 syntax is a highly expressive language feature I like a lot, because it packs a lot of functionality into just a few characters, and those characters concisely describe to the reader exactly what the code does.
I could have topicalized the @rings.map() call instead of using @sums, but then I’d have needed to use .cache, and it didn’t make the code any better.
That’s it for this challenge. See you next week.