This Week a Ranking Occurred!

The examples used here are from the weekly challenge problem statement and demonstrate the working solution.

File Index

"ch-1.pl" Defined by 1.

"ch-2.pl" Defined by 5.

Part 1: Unique Occurrences

You are given an array of integers, @ints. Write a script to return 1 if the number of occurrences of each value in the given array is unique or 0 otherwise.

The complete solution is contained in one file that has a simple structure.

"ch-1.pl" 1

preamble 2
unique occurrences 3
main 4

For this problem we do not need to include very much. We’re specifying to use the current version of Perl, for all the latest features. We’re also using the boolean module, for the convenience of returning and displaying the return values.

This fragment is also used in Part 2.

preamble 2 ⟩≡

use v5.38;
use boolean;

Fragment referenced in 1, 5.

Here we have a single function which does essentially all the work. First we loop through the array of numbers and count occurrences. Then the counts are themselves used as hash keys to eliminate duplicates. If no duplicates are removed then the number of these new keys is equal to the number of original count values.

unique occurrences 3 ⟩≡

sub unique_occurrences{
my %occurrences;
} for @_;
my %h;
do{$h{$_} = undef} for values %occurrences;
return boolean(values %occurrences == keys %h);

Fragment referenced in 1.

Finally, we have a few lines of code for running some tests.

main 4 ⟩≡

say unique_occurrences 1, 2, 2, 1, 1, 3;
say unique_occurrences 1, 2, 3;
say unique_occurrences -2, 0, 1, -2, 1, 1, 0, 1, -2, 9;

Fragment referenced in 1.

Sample Run
$ perl perl/ch-1.pl 

Part 2: Dictionary Rank

You are given a word, $word. Write a script to compute the dictionary rank of the given word.

The solution to the second part of this week’s challenge is a little more complex than the first part. In the solution file we define our own function for computing all permutations of an array, which is then used to determine the dictionary rank.

"ch-2.pl" 5

preamble 2
Compute all valid permutations with Heap’s algorithm. 6
Determine the dictionary rank. 7
main 8

This function is a recursive implementation of Heap’s algorithm. A lot has been written on this algorithm, so I won’t go into much detail here.

Compute all valid permutations with Heap’s algorithm. 6 ⟩≡

sub permutations{
my($a, $k, $permutations) = @_;
if($k == 1){
push @{$permutations}, [@{$a}];
return true;
permutations($a, $k - 1, $permutations);
for my $i (0 .. $k - 2){
if($k & 1){
($a->[0], $a->[$k - 1]) = ($a->[$k - 1], $a->[0]);
($a->[$i], $a->[$k - 1]) = ($a->[$k - 1], $a->[$i]);
permutations($a, $k - 1, $permutations);

Fragment referenced in 5.

Now that we have a way to compute all permutations we will use that to determine the dictionary rank. There is a trick here. Keep in mind that dictionaries do not have multiple entries for repeated words! In the case of words with repeated letters than there will be permutations that are effectively equal in that they contain the same letters. Although they are created by permuting equal (but different) letters for ranking purposes we will consider them the same.

Determine the dictionary rank. 7 ⟩≡

sub dictionary_rank{
my($word) = @_;
my $permutations = [];
permutations [split //, $word], length($word), $permutations;
my %h;
do {$h{join q//, @{$_}} = undef} for @{$permutations};
my @permutations = sort {$a cmp $b} keys %h;
return (
grep {$permutations[$_] eq $word} 0 .. @permutations - 1
)[0] + 1;

Fragment referenced in 5.

main 8 ⟩≡

say dictionary_rank q/CAT/;
say dictionary_rank q/GOOGLE/;
say dictionary_rank q/SECRET/;

Fragment referenced in 5.

Sample Run
$ perl ch-2.pl 


The Weekly Challenge 260
Generated Code
Heap’s Algorithm

posted at: 20:39 by: Adam Russell | path: /perl | permanent link to this entry