Perl Weekly Challenge: Week 9
Challenge 1:
Write a script that finds the first square number that has at least 5 distinct digits. This was proposed by Laurent Rosenfeld.
We start from 100 because any number less than 100 squared will have less than 5 digits and thus will never fulfill the criterion.
my $n = 100;
Now we go into an infinite loop...
loop {
...we square $n.
my $nsquared = $n * $n;
Then we create a Hash whose keys will be the digits in $n and whose values will be the number of times that
digit occurs.
my %digits;
$nsquared.comb.map({ %digits{$_} = True; });
If %digits has 5 or more keys, it means it means $nsquared has 5 or more distinct digits. In this case, we print the
answer and exit the loop.
if (%digits.elems == 5) {
say "$nsquared ($n * $n)";
last;
}
Otherwise we increment $n and do the next iteration of the loop.
$n++;
}
In hindsight, I would have done this as a one-liner like this:
my $n=100; loop { $n².comb.Set.elems == 5 && last; $n++ }; say "{$n²} ($n * $n)"
A Set is more appropriate for this task than a Hash. And note the cool use of a unicode superscript to represent
the square operation.
The Perl version is much the same.
my $n = 100;
We have to use while(1) to do an infinite loop.
while(1) {
And no fancy ways of squaring a number, we just have to multiply it by it self.
my $nsquared = $n * $n;
my %digits;
map { $digits{$_} = 1; } (split //, $nsquared);
if (scalar keys %digits == 5) {
say "$nsquared ($n * $n)";
last;
}
$n++;
};
By the way in case you were wondering, the answer is 12769 (113 squared.)
Challenge 2:
Write a script to perform different types of ranking as described below:
- Standard Ranking (1224): Items that compare equal receive the same ranking number, and then a gap is left in the ranking numbers.
- Modified Ranking (1334): It is done by leaving the gaps in the ranking numbers before the sets of equal-ranking items.
- Dense Ranking (1223): Items that compare equally receive the same ranking number, and the next item(s) receive the immediately following ranking number. For more information, please refer to wiki page.
Raku (or Perl 6 as it was referred to back then) has the really handy feature of multi subs which let you use the same name for
more than one subroutine as long as the arguments are different. With the MAIN() routine, this can be used to call the script
in different ways depending on which command-line parameters you give it. So for example, if called with -s, the script will
perform a Standard ranking, with -m, a Modified ranking and with -d, a Dense ranking. In each case, the rest of the
command-line parameters are the items to be ranked. Each of the three varieties of MAIN() works the same. After .sort()ing
the @items, it group()s them in case there is more than one item of the same kind, ranks these groups (the function used to rank
is the only major difference) and display()s the results.
multi sub MAIN (
*@items, #= a list of items to rank
Bool :$d! where .so #= dense ranking
) {
@items.sort ==> group() ==> denseRank() ==> display();
}
multi sub MAIN (
*@items,
Bool :$m! where .so #= modified ranking
) {
@items.sort ==> group() ==> modifiedRank() ==> display();
}
multi sub MAIN (
*@items,
Bool :$s! where .so #= standard ranking
) {
@items.sort ==> group() ==> standardRank() ==> display();
}
The group() functions' purpose as mentioned, is to group consecutive identical items together and assign each
group a rank starting from 1 using a Hash.
sub group(@items) {
my %groups;
my $rank = 1;
my $current = @items[0];
for @items -> $item {
if $item !~~ $current {
$rank++;
$current = $item;
}
%groups{$rank}.push($item);
}
return %groups;
}
These three subroutines implement the different ranking strategies for the groups created by group().
Each subroutine returns a List of Pair objects, where each pair contains the assigned rank and the corresponding item.
sub denseRank(%groups) {
my @results;
for %groups.keys.sort -> $rank {
for %groups{$rank}.list -> $item {
@results.push(Pair.new($rank, $item));
}
}
return @results;
}
sub modifiedRank(%groups) {
my @results;
my $total = 0;
for %groups.keys.sort -> $rank {
$total += %groups{$rank}.elems;
for %groups{$rank}.list -> $item {
@results.push(Pair.new($total, $item ));
}
}
return @results;
}
sub standardRank(%groups) {
my @results;
my $total = 1;
for %groups.keys.sort -> $rank {
for %groups{$rank}.list -> $item {
@results.push(Pair.new($total, $item ));
}
$total += %groups{$rank}.elems;
}
return @results;
}
The ranked lists are printed out in the display() function.
sub display(@results) {
for @results -> Pair $result {
say $result.key, ' -> ', $result.value;
}
}
The Perl version only has one big difference.
sub group {
my ($items) = @_;
my %groups;
my $rank = 1;
my $current = $items->[0];
for my $item (@{$items}) {
if ($item !~ $current) {
$rank++;
$current = $item;
}
push @{$groups{$rank}}, $item;
}
return \%groups;
}
sub denseRank {
my ($groups) = @_;
my @results;
for my $rank (sort keys %{$groups}) {
for my $item (@{$groups->{$rank}}) {
push @results, [ $rank, $item];
}
}
return \@results;
}
sub modifiedRank {
my ($groups) = @_;
my @results;
my $total = 0;
for my $rank (sort keys %{$groups}) {
$total += scalar @{$groups->{$rank}};
for my $item (@{$groups->{$rank}}) {
push @results, [ $total, $item ];
}
}
return \@results;
}
sub standardRank {
my ($groups) = @_;
my @results;
my $total = 1;
for my $rank (sort keys %{$groups}) {
for my $item (@{$groups->{$rank}}) {
push @results, [ $total, $item ];
}
$total += scalar @{$groups->{$rank}};
}
return \@results;
}
sub display {
my ($results) = @_;
for my $result (@{$results}) {
say "$result->[0] -> $result->[1]";
}
}
In the absence of multimethods, we have to use if/else to parse the command-line switches and arguments.
if (scalar @ARGV < 2) {
usage();
}
my $opt = shift @ARGV;
my @items = sort @ARGV;
if ($opt eq '-d') {
display(denseRank(group(\@items)));
} elsif ($opt eq '-m') {
display(modifiedRank(group(\@items)));
} elsif ($opt eq '-s') {
display(standardRank(group(\@items)));
} else {
usage();
}
And we don't get a prebuilt usage() function so we have to build our own.
sub usage {
print <<"-USAGE-";
Usage:
$0 -d <items>
$0 -m <items>
$0 -s <items>
-d dense ranking
-m modified ranking
-s standard ranking
<numbers> a list of items to rank
-USAGE-
exit(1);
}