RabbitFarm
2024-03-16
This Week a Ranking Occurred!
The examples used here are from the weekly challenge problem statement and demonstrate the working solution.
File Index
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.
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.
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.
-
sub unique_occurrences{
my %occurrences;
do{
$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:{
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 1 0 1
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.
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.
-
sub permutations{
my($a, $k, $permutations) =@_;
if($k == 1){
push@{$permutations}, [@{$a}];
return true;
}
else{
permutations($a, $k - 1, $permutations);
for my $i (0 .. $k - 2){
if($k & 1){
($a->[0], $a->[$k - 1]) = ($a->[$k - 1], $a->[0]);
}
else{
($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.
-
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:{
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 3 88 255
References
posted at: 20:39 by: Adam Russell | path: /perl | permanent link to this entry