# 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