Perl Weekly Challenge 233.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 233.
Task 1: Similar Words
Submitted by: Mohammad S Anwar
You are given an array of words made up of alphabets only.
Write a script to find the number of pairs of similar words. Two words are similar
if they consist of the same characters.
Example 1
Input: @words = ("aba", "aabb", "abcd", "bac", "aabc")
Output: 2
Pair 1: similar words ("aba", "aabb")
Pair 2: similar words ("bac", "aabc")
Example 2
Input: @words = ("aabb", "ab", "ba")
Output: 3
Pair 1: similar words ("aabb", "ab")
Pair 2: similar words ("aabb", "ba")
Pair 3: similar words ("ab", "ba")
Example 3
Input: @words = ("nba", "cba", "dba")
Output: 0
For each word I can make a canonical representation of its characters
and use a hash to count how many times N it appears. The number of
pairs I can form from each set is the number of combinations of k
taken in groups of 2, k!/((k-2)! 2!)=k (k-1)/2. The result is the sum of these numbers.
The code fits a two liner:
Example 1:
perl -MList::Util=uniq,sum0 -E '
$k{join "", sort {$a cmp $b} uniq split "", lc($_)}++ for (@ARGV);
say "@ARGV -> ", sum0 map {$k{$_}*($k{$_}-1)/2} grep {$k{$_}>1} keys %k;
' aba aabb abcd bac aabc
Results:
aba aabb abcd bac aabc -> 2
Example 2:
perl -MList::Util=uniq,sum0 -E '
$k{join "", sort {$a cmp $b} uniq split "", lc($_)}++ for (@ARGV);
say "@ARGV -> ", sum0 map {$k{$_}*($k{$_}-1)/2} grep {$k{$_}>1} keys %k;
' aabb ab ba
Results:
aabb ab ba -> 3
Example 3:
perl -MList::Util=uniq,sum0 -E '
$k{join "", sort {$a cmp $b} uniq split "", lc($_)}++ for (@ARGV);
say "@ARGV -> ", sum0 map {$k{$_}*($k{$_}-1)/2} grep {$k{$_}>1} keys %k;
' nba cba dba
Results:
nba cba dba -> 0
The full code follows:
1 # Perl weekly challenge 233
2 # Task 1: Similar Words
3 #
4 # See https://wlmb.github.io/2023/09/04/PWC233/#task-1-similar-words
5 use v5.36;
6 use List::Util qw(uniq sum0);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 w1 [w2...]
9 to count pairs of related words w1, w2, etc.
10 FIN
11 my %count;
12 # convert to lower case, split, find unique elements, sort them and join them
13 # to obtain unique representation of characters of word. Count how many appear.
14 $count{join "", sort {$a cmp $b} uniq split "", lc($_)}++ for (@ARGV);
15 my %pairs;
16 $pairs{$_}=$count{$_}*($count{$_}-1)/2 for grep {$count{$_}>=2} keys %count;
17 my $result=sum0 values %pairs;
18 say "@ARGV -> $result";
Examples:
./ch-1.pl aba aabb abcd bac aabc
./ch-1.pl aabb ab ba
./ch-1.pl nba cba dba
Results:
aba aabb abcd bac aabc -> 2
aabb ab ba -> 3
nba cba dba -> 0
Task 2: Frequency Sort
Submitted by: Mohammad S Anwar
You are given an array of integers.
Write a script to sort the given array in increasing order based on the
frequency of the values. If multiple values have the same frequency then
sort them in decreasing order.
Example 1
Input: @ints = (1,1,2,2,2,3)
Ouput: (3,1,1,2,2,2)
'3' has a frequency of 1
'1' has a frequency of 2
'2' has a frequency of 3
Example 2
Input: @ints = (2,3,1,3,2)
Ouput: (1,3,3,2,2)
'2' and '3' both have a frequency of 2, so they are sorted in decreasing order.
Example 3
Input: @ints = (-1,1,-6,4,5,-6,1,4,1)
Ouput: (5,-1,4,4,-6,-6,1,1,1)
I count how many times each input appears and use as the first part of a comparison routine for sorting the values. This fits a oneliner.
Example 1:
perl -E '
$c{$_}++ for @ARGV; say "@ARGV -> ", join " ", sort {$c{$a} <=> $c{$b} || $b <=> $a} @ARGV;
' 1 1 2 2 2 3
Results:
1 1 2 2 2 3 -> 3 1 1 2 2 2
Example 2:
perl -E '
$c{$_}++ for @ARGV; say "@ARGV -> ", join " ", sort {$c{$a} <=> $c{$b} || $b <=> $a} @ARGV;
' 2 3 1 3 2
Results:
2 3 1 3 2 -> 1 3 3 2 2
Example 3:
perl -E '
$c{$_}++ for @ARGV; say "@ARGV -> ", join " ", sort {$c{$a} <=> $c{$b} || $b <=> $a} @ARGV;
' -- -1 1 -6 4 5 -6 1 4 1
Results:
-1 1 -6 4 5 -6 1 4 1 -> 5 -1 4 4 -6 -6 1 1 1
The corresponding full code is:
1 # Perl weekly challenge 233
2 # Task 2: Frequency Sort
3 #
4 # See https://wlmb.github.io/2023/09/04/PWC233/#task-2-frequency-sort
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 N1 [N2...]
8 to sort the numbers Ni according to their frequencies (increasing)
9 and their values (decreasing).
10 FIN
11 my %count;
12 $count{$_}++ for @ARGV;
13 my @sorted=sort {$count{$a} <=> $count{$b} || $b <=> $a} @ARGV;
14 say "@ARGV -> @sorted";
Examples:
./ch-2.pl 1 1 2 2 2 3
./ch-2.pl 2 3 1 3 2
./ch-2.pl -1 1 -6 4 5 -6 1 4 1
Results:
1 1 2 2 2 3 -> 3 1 1 2 2 2
2 3 1 3 2 -> 1 3 3 2 2
-1 1 -6 4 5 -6 1 4 1 -> 5 -1 4 4 -6 -6 1 1 1
Written on September 4, 2023