Squared Ranking with Perl 6

by Arne Sommer

Squared Ranking with Perl 6

Published 25. May 2019

This is my response to the Perl Weekly Challenge #9.

Challenge #9.1

«Write a script that finds the first square number that has at least 5 distinct digits. This was proposed by Laurent Rosenfeld.»

File: square-five
for 100 .. Inf                                                           # [1]
{
  my $candidate = $_ ** 2;                                               # [2]

  ( say "$_ -> $candidate"; last ) if $candidate.comb.Bag.elems >= 5;
} # [3] ########################## # [4] ###########################   

[1] From 100 so that we start with the lowest possible 5 digit number which is 10000 - or 1002. 100 obviously isn't the answer, but neither are the values 1 to 99. So we can skip them.

[2] The value squared.

[3] A postfix «if» statement is usually added to a single statement, but we can abuse it by specifying several in parens (which is actually the grouping operator, and not a list generator) - or the more familiar block constructor curlies:

  { say "$_ -> $candidate"; last } if $candidate.comb.Bag.elems >= 5;

[4] We take the (squared) value, making a list of each individual digit (with «comb»), coercing that list into a Bag (which is a data structure where the values are the frequency of the keys), and checking if we have at least 5 entries (or different digits).

See docs.perl6.org/type/Bag for more information about «Bag».

Running it gives the answer; 12769:

$ perl6 square-five
113 -> 12769

We can do it as a one-liner:

File: square-five-oneliner
( say "$_ -> { $_ ** 2 }"; last ) if ($_ ** 2).comb.Bag.elems >= 5 for 100..Inf;

It is possible to make it even shorter:

File: square-five-oneliner2
( say "$_ -> { $_² }"; last ) if $_².comb.Bag.elems >= 5 for 100 .. *;

Perl 6 supports Unicode Superscript Digits. Even several:

> say 10⁴⁵;
1000000000000000000000000000000000000000000000

Your printer may not like you if you try to print them, though.

And they behave in (perhaps) strange ways, as they are taken for normal digits if used in a non-exponentiation context:

> say ⁴⁵;       # -> 1024
> say 4⁵;       # -> 1024

> say 10-⁴⁵;    # -> -1014
> say 10 - 4⁵;  # -> -1014

Challenge #9.2

«Write a script to perform different types of ranking as described below:

  1. Standard Ranking (1224): Items that compare equal receive the same ranking number, and then a gap is left in the ranking numbers.
  2. Modified Ranking (1334): It is done by leaving the gaps in the ranking numbers before the sets of equal-ranking items.
  3. 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

I have chosen to make a single program, taking the values as arguments (on the command line), and computing the three rankings. I'll present them one at a time, and show the output at the end:

File: ranking (partial)
unit sub MAIN (*@values);                                   # [1]

say "Standard Ranking: ", std-ranking(@values).join(", ");  # [2]

sub std-ranking(@values)
{
  my $count = @values.Bag;                                  # [3]
  my %rankings;                                             # [4]
  my $current-ranking = 1;                                  # [5]

  for $count.keys.sort                                      # [6]
  {
    %rankings{$_} = $current-ranking;                       # [7]
    $current-ranking += $count{$_};                         # [8]
  }

  return @values.map({ %rankings{$_} });                    # [9]
  # my @return; @return.push(%rankings{$_}) for @values; return @return; # [10]
}

[1] Get the arguments from the command line. They come as individual values, so we use the slurpy prefix «*» to get them into an array.

[2] Pass the array to «std-ranking», and print the result array.

[3] Set up a Bag (as explained in Challenge #9.1), so that we get a count of the values.

[4] This hash is used to store the ranking for the values; the key is the value, and the value is the ranking.

[5] The lowest value has the ranking value 1.

[6] Loop through the values, in sorted order

[7] • the ranking for the lowest value is 1

[8] • then we add the occurence of this lowest value, to be used as the ranking for the next lowest value. And so on.

[9] We return the rankings, in the order of the values in the original array.

[10] If you don't like «map», take a look at the alternative.

File: ranking (partial)
say "Modified Ranking: ", modified-ranking(@values).join(", ");

sub modified-ranking(@values)
{
  my $count = @values.Bag;
  my %rankings;
  my $current-ranking = 0;             # [1]

  for $count.keys.sort
  {
    $current-ranking += $count{$_};    # [2]
    %rankings{$_} = $current-ranking;
  }

  return @values.map({ %rankings{$_} });
}

[1] A slight adjustment, so that the code in [2] works.

[2] We add the occurence of the value before setting the rank this time.

File: ranking (partial)
say "Dense    Ranking: ", dense-ranking(@values).join(", ");

sub dense-ranking(@values)
{
  my $set = @values.Set;                                 # [1]
  my %rankings;
  my $current-ranking = 0;

  %rankings{$_} = ++$current-ranking for $set.keys.sort; # [2]

  return @values.map({ %rankings{$_} });
}

[1] We don't need the count this time, so a «Set» (where we only save the presence of a value) is more suitable than a «Bag».

[2] The ranking is incremented by one for each value (in sorted order), so we can use «++». I have used the prefix version, but postfix would work as well - if we set the initial value to 1 instead of 0.

See my Perl 6 Anagrams article or docs.perl6.org/type/Set for more information about «Set».

Running it:

$ perl6 ranking 1 2 3 4 5
Standard Ranking: 1, 2, 3, 4, 5
Modified Ranking: 1, 2, 3, 4, 5
Dense    Ranking: 1, 2, 3, 4, 5

$ perl6 ranking 1 1 1 1 1 
Standard Ranking: 1, 1, 1, 1, 1
Modified Ranking: 5, 5, 5, 5, 5
Dense    Ranking: 1, 1, 1, 1, 1

$ perl6 ranking 1 1 1 1 2 1
Standard Ranking: 1, 1, 1, 1, 6, 1
Modified Ranking: 5, 5, 5, 5, 6, 5
Dense    Ranking: 1, 1, 1, 1, 2, 1

$ perl6 ranking 1 2 3 4 5 A S 1 1 1 1 1
Standard Ranking: 1, 7, 8, 9, 10, 11, 12, 1, 1, 1, 1, 1
Modified Ranking: 6, 7, 8, 9, 10, 11, 12, 6, 6, 6, 6, 6
Dense    Ranking: 1, 2, 3, 4, 5, 6, 7, 1, 1, 1, 1, 1

The sorting order is entirely up to «sort». Let us have a look at how it treats numbers with several digits:

$ perl6 ranking 1 2 3 4 10
Standard Ranking: 1, 2, 3, 4, 5
Modified Ranking: 1, 2, 3, 4, 5
Dense    Ranking: 1, 2, 3, 4, 5

$ perl6 ranking 1 2 3 4 10 A
Standard Ranking: 1, 2, 3, 4, 5, 6
Modified Ranking: 1, 2, 3, 4, 5, 6
Dense    Ranking: 1, 2, 3, 4, 5, 6

And that's it.