laurent_r

These are some answers to the Week 60 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Please note that this blog post will be shorter than usual, since I’m a bit short of time to prepare it.

Task 1: Excel Columns

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

Excel Columns in Raku

We first create a lazy infinite list, @cols, of Excel column names. Note that we start with an empty string to avoid an off-by-one issue (as Excel column numbers starts at 1, not 0). We then create a hash mapping column names to column numbers.

We use two multi MAIN subroutines, one to convert number to names, and one to convert names to number.

use v6;

constant \MAX = 16_384;
my @cols = '', 'A', 'B' ... *;
my %nums = map { @cols[$_] => $_}, 1..MAX;

multi sub MAIN (Int $n = 28) {
    say "Column $n = @cols[$n]";
}

multi sub MAIN (Str $col-name where * ~~ /^<[A..Z]>+$/) {
    say "Column $col-name = %nums{$col-name}";
}

These are a few sample runs:

$ perl6 excel-cols.p6
Column 28 = AB

$ perl6 excel-cols.p6 44
Column 44 = AR

$ perl6 excel-cols.p6 431
Column 431 = PO

$ perl6 excel-cols.p6 AB
Column AB = 28

$ perl6 excel-cols.p6 AR
Column AR = 44

$ perl6 excel-cols.p6 PO
Column PO = 431

Excel Columns in Perl

This is essentially a port to Perl of the Raku program. Since we cannot have lazy infinite lists in Perl, we define a MAXLET constant (equal to “XFD”, corresponding to 16384 in numeric notation). Similarly, since we cannot have multiple MAIN subroutines in Perl, we analyze whether the input value is an integer or a string of letters between A and Z to decide in which direction to perform the conversion:

use strict;
use warnings;
use feature qw /say/;
use constant MAXNUM => 16_384;
use constant MAXLET => 'XFD';

my @cols = ('', 'A'..MAXLET);
my %nums = map { $cols[$_] => $_ } 1..MAXNUM;
my $in = shift // 28;
if ($in =~ /^\d+$/) {
    say "Column $in = $cols[$in]";
} elsif ( $in =~ /^[A-Z]+$/ ) {
    say "Column $in = $nums{$in}";
} else {
    say "$in is invalid input.";
}

Example output:

$ perl excel-cols.pl AA
Column AA = 27

$ perl excel-cols.pl ZZ
Column ZZ = 702

$ perl excel-cols.pl 16000
Column 16000 = WQJ

$ perl excel-cols.pl 16384
Column 16384 = XFD

Task 2: Finding Numbers

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;

With this input, the output should be:

10, 11, 12, 15, 20

Finding Numbers in Raku

We use the combinations to generate digit combinations, and the permutations method on these combinations, concatenate the permutations generated into numbers and then print out numbers whose length and value match the input criteria.

sub MAIN (Int $length, Int $max-val, Str $list) {
    my @L = | $list.split(" ") xx $length;
    my @out;
    for @L.combinations: 1..$length -> $seq {
        for $seq.permutations>>.join('') -> $num {
            push @out, +$num if $num < $max-val 
                and $num.Int.chars == $length;
        }    
    }
    .say for @out.sort.squish;
}

Sample runs:

$ perl6 find-numbers.p6 2 50 "3 4 5"
33
34
35
43
44
45


$ perl6 find-numbers.p6 2 21 "0 1 2 5"
10
11
12
15
20


$ perl6 find-numbers.p6 3 145 "0 1 2 5 12 31"
100
101
102
105
110
111
112
115
120
121
122
125
131

Finding Numbers in Perl

Here, we write a recursive permute subroutine to generate all possible numbers from the input list, and then print out the numbers whose length and value match the input criteria.

use strict;
use warnings;
use feature qw /say/;

my $length = shift;
my $max_val = shift;
my @L = @ARGV;

sub permute {
    my ($seed, @list) = @_;
    return if length $seed > $length;
    for my $val (@list) {
        next if $seed eq "" and $val == 0;
        my $new_seed = 0 + ($seed . $val);
        say $new_seed if length $new_seed == $length 
            and $new_seed < $max_val;
        permute($new_seed, @list);
    }
}

permute "", @L;

Sample runs:

$ perl find-numbers.pl 2 41 3 1 2 5
33
31
32
35
13
11
12
15
23
21
22
25

$ perl find-numbers.pl 2 21 0 1 2 5
10
11
12
15
20

Wrapping up

The next week Perl Weekly Challenge is due to start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on Sunday, May 24, 2020. And, please, also spread the word about the Perl Weekly Challenge if you can.