RogerBW's Blog

I’ve been doing the Perl Weekly Challenges. The latest involved working with a form of numeric encoding, and a very arbitrary numerical problem.

Write a script that accepts a number and returns the Excel Column Name it represents and vice-versa.

Excel columns start at A and increase lexicographically using the 26 letters of the English alphabet, A..Z. After Z, the columns pick up an extra “digit”, going from AA, AB, etc., which could (in theory) continue to an arbitrary number of digits. In practice, Excel sheets are limited to 16,384 columns.

Example

Input Number: 28 Output: AB

Input Column Name: AD Output: 30

So this looks like base-26, but it isn't, because sometimes a zero is "A" and sometimes it's a leading blank. For example, A..Z gives you 26 entries; AA..ZZ gives you 26²=676. So the total number of values you can represent by one or two characters is the sum of those two, 702 (or 26×27). Similarly, AAA..ZZZ gives you 26³=17576 for a total of 18278.

I ended up treating each distinct number of letters as its own internally-consistent base system, with an offset for any shorter strings. So AA is 0 * 26 + 0 * 1 + 26 offset for single-character strings + 1 because we're horrible people who start counting at 1 rather than at 0 as Richards and Dijkstra intended.

The first step is a test harness with letter-number mappings taken from LibreOffice and some Excel help sites:

foreach my $testpair (
  [1,'A'],
  [26,'Z'],
  [27,'AA'],
  [52,'AZ'],
  [53,'BA'],
  [520,'SZ'],
  [620,'WV'],
  [676,'YZ'],
  [677,'ZA'],
  [701,'ZY'],
  [702,'ZZ'],
  [703,'AAA'],
  [1024,'AMJ'],
  [2600,'CUZ'],
  [10000,'NTP'],
    ) {
  my $l=encode($testpair->[0]);
  if ($l ne $testpair->[1]) {
    die "Failed $testpair->[0] gives $l should be $testpair->[1]\n";
  }
  $l=decode($testpair->[1]);
  if ($l ne $testpair->[0]) {
    die "Failed $testpair->[1] gives $l should be $testpair->[0]\n";
  }
}

The encoder. First work out which digit-block we're in.

sub encode {
  my $in=shift;
  my $b=26;
  my $c=$b;
  my $d=1;
  while ($in > $c) {
    $in-=$c;
    $c*=$b;
    $d++;
  }
  $in--;

Then do a straightforward base-26 conversion.

  my @digits;
  my @c=('A'..'Z');
  foreach (1..$d) {
    unshift @digits,$c[$in % $b];
    $in=int($in/$b);
  }
  return join('',@digits);
}

Decoding is much the same in reverse. Do the decoding, then offset based on the length of the input.

sub decode {
  my $in=shift;
  my @c=('A'..'Z');
  my %c=map {$c[$_] => $_} (0..$#c);
  my @digits=split '',$in;
  my $d=scalar @digits;
  my $b=26;
  my $o=0;
  foreach (@digits) {
    $o*=$b;
    $o+=$c{$_};
  }
  my $c=1;
  $o++;
  foreach (2..$d) {
    $c*=$b;
    $o+=$c;
  }
  return $o;
}

Perl6 is basically the same, except for using truncate and comb instead of int and split.

Write a script that accepts list of positive numbers (@L) and two positive numbers $X and $Y.

The script should print all possible numbers made by concatenating the numbers from @L, whose length is exactly $X but value is less than $Y.

Example

Input:

@L = (0, 1, 2, 5);

$X = 2;

$Y = 21;

Output:

10, 11, 12, 15, 20

Yes, but why? Why do I want to do this, what does it represent? Dash it all, what's my motivation?

One error in the specification: 0 is not a positive number. One ambiguity: only the example states that numbers can be repeated. Otherwise I'd do it with a permuter.

Anyway, this sort of hierarchical counter is a standard pattern. I optimise slightly because if I want X digits I don't need more than X counters. (One number might consist of more than one digit – there's nothing to say there can't be a 23 in @L – so I still have to check the length.)

my %out;
my @counter=(0) x $X;
my $d=1;
while ($d) {

Here we build the candidate number, and see if it fits.

  my $c=join('',map {$L[$_]} @counter);
  $c =~ s/^0+//;
  if (length($c) == $X && $c < $Y) {
    $out{$c}=1;
  }

And this is just the usual counter boilerplate.

  my $i=0;
  while (1) {
    $counter[$i]++;
    if ($counter[$i] <= $#L) {
      last;
    }
    $counter[$i]=0;
    $i++;
    if ($i>$#counter) {
      $d=0;
      last;
    }
  }
}

print map {"$_\n"} sort keys %out;

Perl6 is not significantly different.