Download the raw code. And Position.pm6.
# -*- mode: cperl6; -*-
# 2011 Perl 6 Coding Contest
# Edgar Gonzàlez i Pellicer
use v6;
use Position;
# Target
my Int $target;
# Best solution so far
my Int @best-sol;
my Int $best-length;
# Find greedy solution
sub find-greedy() {
# Powers of two up to the target
my @powers = 1, 2, 4 ...^ * > $target;
# Find bits
my @bits = sprintf('%b', $target).comb(/./).reverse>>.Int;
# Find first 1
my $i = 0;
++$i while !@bits[$i]; # There will be one for sure
# All powers of two will take part in the solution
my $sol = @powers;
# Find required extra steps
my $sum = @powers[$i];
for $i ^..^ +@bits -> $j {
if @bits[$j] {
$sum += @powers[$j];
$sol.push($sum);
}
}
# Set as solution
@best-sol = $sol.list;
$best-length = $sol.elems;
}
# Current solution
my Int @current-sol;
my Int %current-sol;
my Int $current-max;
# Backtrack
sub backtrack(PosPair $pp0) {
# Pruning #1: Larger than the best?
return if @current-sol >= $best-length - 1;
# Pruning #2: Achivable upper bound is lower than target
my $ub = $current-max * (2 ** ($best-length - @current-sol));
return if $ub < $target;
# Try with all combinations
for $pp0 .. end(@current-sol) -> $pp {
# The new one
my $new = @current-sol[$pp.i] + @current-sol[$pp.j];
# Larger than the target?
if $new > $target {
# Skip!
}
# Is it the target?
elsif $new == $target {
# We updated the best solution
@best-sol = @current-sol;
@best-sol.push($new);
$best-length = @best-sol.elems;
}
# Is it not already there?
elsif !%current-sol.exists($new) {
# Add it
%current-sol{$new} = 1;
@current-sol.push($new);
# Update max
my $prev-max = $current-max;
$current-max max= $new;
# Backtrack from the next position on,
# to avoid already tried pairs
backtrack($pp.succ);
# Restore
%current-sol.delete($new);
@current-sol.pop();
$current-max = $prev-max;
}
}
}
# Solve
sub solve(Int $n) {
# Positive?
if $n > 0 {
# Set as target
$target = $n;
# Find the greedy solution, to allow pruning
find-greedy();
# Try to backtrack to improve
@current-sol = 1;
%current-sol = 1 => 1;
$current-max = 1;
backtrack(start(@current-sol));
# Show the solution
say('(' ~ @best-sol.sort.join(', ') ~ ')');
}
else {
# Error
say('Argument must be positive.');
}
}
# Main
## Without arguments
multi sub MAIN() {
# Read and solve each line
for $*IN.lines {
solve(.Int);
}
}
# Main
## With arguments
multi sub MAIN(*@ARGS) {
# For each one
for @ARGS {
solve(.Int);
}
}
# Call main
MAIN(|@*ARGS);
Position.pm6:
# -*- mode: cperl6; -*-
# 2011 Perl 6 Coding Contest
# Edgar Gonzàlez i Pellicer
# Positions
module Position;
# Position pair
class PosPair is export {
has Int $.i;
has Int $.j;
# Next
method succ() {
if $.j == $.i {
return PosPair.new(i => $.i + 1, j => 0);
}
else {
return PosPair.new(i => $.i, j => $.j + 1);
}
}
# Conversion to numeric
method Numeric() {
return $.i * ($.i + 1) / 2 + $.j;
}
}
# Position pair at the start of a container
sub start($) is export {
return PosPair.new(i => 0, j => 0);
}
# Position pair at the end of a container
sub end($container) is export {
return PosPair.new(i => $container.elems - 1,
j => $container.elems - 1);
}
The code produces correct results.
Nothing to comment on here. Looks good.
It's clear that some thought has gone into this solution.
Some of the comments only take up unnecessary space by re-stating what is already clear from the program code itself.
The attribute names .i
and .j
are woefully nondescript.
The solution starts off from a powers-of-two chain. The later "backtracking" is still just a recursive search through a lot of solutions, making this solution of the same complexity as the other depth-first solutions.
There's no need to store $best-length
, since an array knows its length in
Perl 6.
The cute while
loop to find the first 1
would've been an excellent
opportunity to use the Perl 6 built-in &first
, which works like &grep
but
stops after the first match.
It's really nice to see a custom-defined .succ
method so that ranges of a
user-defined object type can then be employed. That is a pleasurable form of
abstraction.
A happy shout-out to the use of max=
.
Spread out over a longish script and a module.