t3/edgar

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);
}

Correctness

The code produces correct results.

Consistency

Nothing to comment on here. Looks good.

Clarity of intent

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.

Algorithmic efficiency

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.

Idiomatic use of Perl 6

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=.

Brevity

Spread out over a longish script and a module.