Robbie Hatley's Solutions To The Weekly Challenge #260

For those not familiar with "The Weekly Challenge", it is a weekly programming puzzle with two parts, cycling every Sunday. You can find it here:

The Weekly Challenge

This week (2024-03-10 through 2024-03-16) is weekly challenge #260. Its tasks are as follows:

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Task 260-1: Unique Occurrences
Submitted by: Mohammad Sajid Anwar
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.

Example 1:
Input: @ints = (1,2,2,1,1,3)
Output: 1
The number 1 occurred 3 times.
The number 2 occurred 2 times.
The number 3 occurred 1 time.
All occurrences are unique, therefore the output is 1.

Example 2
Input: @ints = (1,2,3)
Output: 0

Example 3
Input: @ints = (-2,0,1,-2,1,1,0,1,-2,9)
Output: 1

There are probably other ways to solve this (TIMTOWTDI), but the method I stumbled on was to first create a sub called "occurrences" which returns a list of the occurrences of the various kinds of elements in the input array, then I apply "occurrences" twice, basically "occurrences of occurrences". If the result is a list of 1s, then the occurrences of element kinds are unique, otherwise they aren't. Instead of checking every element of "occurrences of occurrences" individually, I just look at their product; if it's 1, the occurrences are unique, otherwise they aren't:

   use v5.38;
   use utf8;
   use List::Util 'product';
   
   # What are the occurrences of the elements of an array?
   sub occurrences(@array) {
      my %a;
      for my $item (@array) {++$a{$item};}
      return values %a;
   }
   
   # Are the occurrences of the elements of an array unique?
   sub occurrences_are_unique(@array) {
      return 1 == product occurrences occurrences @array;
   }
   
   my @arrays = @ARGV ? eval($ARGV[0]) :
   (
      [1,2,2,1,1,3],
      [1,2,3],
      [-2,0,1,-2,1,1,0,1,-2,9],
   );
   
   for my $aref (@arrays) {
      say '';
      say '@ints = (', join(', ', @$aref), ')';
      occurrences_are_unique @$aref
      and say 1, ' (occurrences are unique)'
      or  say 0, ' (occurrences are not unique)';
   }

Robbie Hatley's Perl Solution to The Weekly Challenge 260-1

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Task 260-2: Dictionary Rank
Submitted by: Mark Anderson
You are given a word, $word. Write a script to compute the
dictionary rank of the given word.

Example 1:
Input: $word = 'CAT'
Output: 3
All possible combinations of the letters:
CAT, CTA, ATC, TCA, ACT, TAC
Arrange them in alphabetical order:
ACT, ATC, CAT, CTA, TAC, TCA
CAT is the 3rd in the list.
Therefore the dictionary rank of CAT is 3.

Example 2:
Input: $word = 'GOOGLE'
Output: 88

Example 3:
Input: $word = 'SECRET'
Output: 255

Example 1 says "combinations", but the context makes it clear that the author actually meant "permutations". With that in mind, I use the "permute" function from CPAN module "Math::Combinatorics" to get a list of all letter orders, then sort, then use the "uniq" function from CPAN module "List::Util" to get rid of duplicates, then use the "firstidx" function from CPAN module "List::MoreUtils" to find the index of the first element which is equal to the original word, then add 1 for 1-indexing:

   use v5.38;
   use utf8;
   use Math::Combinatorics 'permute';
   use List::Util 'uniq';
   use List::MoreUtils 'firstidx';
   
   # What is the "dictionary order" (as defined in the problem
   # description) of a word?
   sub dictionary_order ($word) {
      my @dic = uniq sort map {join '', @$_} permute split //, $word;
      return 1 + firstidx {$_ eq $word} @dic;
   }
   
   my @words = @ARGV ? @ARGV : qw( CAT GOOGLE SECRET );
   
   for my $word (@words) {
      say '';
      say "word = $word";
      say 'dictionary order = ', dictionary_order($word);
   }

Robbie Hatley's Perl Solution to The Weekly Challenge 260-2

That's it for challenge 260; see you on challenge 261!