Perl Weekly Challenge 234.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 234.
Task 1: Common Characters
Submitted by: Mohammad S Anwar
You are given an array of words made up of alphabetic characters only.
Write a script to return all alphabetic characters that show up in all
words including duplicates.
Example 1
Input: @words = ("java", "javascript", "julia")
Output: ("j", "a")
Example 2
Input: @words = ("bella", "label", "roller")
Output: ("e", "l", "l")
Example 3
Input: @words = ("cool", "lock", "cook")
Output: ("c", "o")
A solution may be found by preparing an array that stores for each word how many times each letter appears. Then, for each letter I can choose the minimum number of times it appears, and if positive, that is the number of times it should appear in the output. This yields a two liner.
Example 1:
perl -MList::Util=min -E 'for(@ARGV){my %l; $l{$_}++ for split ""; push @c, \%l;}
say "@ARGV -> ", join " ", map {$l=$_; ($l) x min map {$c[$_]{$l}} 0..@c-1} keys %{$c[0]}
' java javascript julia
Results:
java javascript julia -> j a
Example 2:
perl -MList::Util=min -E 'for(@ARGV){my %l; $l{$_}++ for split ""; push @c, \%l;}
say "@ARGV -> ", join " ", map {$l=$_; ($l) x min map {$c[$_]{$l}} 0..@c-1} keys %{$c[0]}
' bella label roller
Results:
bella label roller -> e l l
Example 3:
perl -MList::Util=min -E 'for(@ARGV){my %l; $l{$_}++ for split ""; push @c, \%l;}
say "@ARGV -> ", join " ", map {$l=$_; ($l) x min map {$c[$_]{$l}} 0..@c-1} keys %{$c[0]}
' cool lock cook
Results:
cool lock cook -> c o
The corresponding full code is:
1 # Perl weekly challenge 234
2 # Task 1: Common Characters
3 #
4 # See https://wlmb.github.io/2023/09/11/PWC234/#task-1-common-characters
5 use v5.36;
6 use List::Util qw(min);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 W1 [W2...]
9 to find the common characters in all words W1, W2...
10 FIN
11 my @letters_of_word;
12 for(@ARGV){
13 my %count_of_letter;
14 $count_of_letter{$_}++ for split "";
15 push @letters_of_word, \%count_of_letter;
16 }
17 my $number_of_words=@letters_of_word;
18 my @result=map {
19 my $letter=$_;
20 my $repetition=min map {
21 my $word_number=$_;
22 $letters_of_word[$word_number]{$letter}//0
23 } 0..$number_of_words-1;
24 ($letter) x $repetition;
25 } keys %{$letters_of_word[0]};
26 say "@ARGV -> @result";
Examples:
./ch-1.pl java javascript julia
./ch-1.pl bella label roller
./ch-1.pl cool lock cook
Results:
java javascript julia -> j a
bella label roller -> l l e
cool lock cook -> o c
Task 2: Unequal Triplets
Submitted by: Mohammad S Anwar
You are given an array of positive integers.
Write a script to find the number of triplets (i, j, k) that satisfies
num[i] != num[j], num[j] != num[k] and num[k] != num[i].
Example 1
Input: @ints = (4, 4, 2, 4, 3)
Ouput: 3
(0, 2, 4) because 4 != 2 != 3
(1, 2, 4) because 4 != 2 != 3
(2, 3, 4) because 2 != 4 != 3
Example 2
Input: @ints = (1, 1, 1, 1, 1)
Ouput: 0
Example 3
Input: @ints = (4, 7, 1, 10, 7, 4, 1, 1)
Output: 28
triplets of 1, 4, 7 = 3x2×2 = 12 combinations
triplets of 1, 4, 10 = 3×2×1 = 6 combinations
triplets of 4, 7, 10 = 2×2×1 = 4 combinations
triplets of 1, 7, 10 = 3x2x1 = 6 combinations
The last example gives a good hint for a solution. First, map each
number to the number of times it appears. Then, for each combination of
three distinct numbers, multiply the corresponding repetitions. Using sum0
and product from List::Util and combinations from
Algorithm::Combinatorics this yields a one liner.
Example 1:
perl -MAlgorithm::Combinatorics=combinations -MList::Util=sum0,product -E '
++$c{$_} for @ARGV; @n=keys %c; say "@ARGV -> ", @n<3?0:sum0 map {product @c{@$_}} combinations(\@n,3);
' 4 4 2 4 3
Results:
4 4 2 4 3 -> 3
Example 2:
perl -MAlgorithm::Combinatorics=combinations -MList::Util=sum0,product -E '
++$c{$_} for @ARGV; @n=keys %c; say "@ARGV -> ", @n<3?0:sum0 map {product @c{@$_}} combinations(\@n,3);
' 1 1 1 1 1
Results:
1 1 1 1 1 -> 0
Example 3:
perl -MAlgorithm::Combinatorics=combinations -MList::Util=sum0,product -E '
++$c{$_} for @ARGV; @n=keys %c; say "@ARGV -> ", @n<3?0:sum0 map {product @c{@$_}} combinations(\@n,3);
' 4 7 1 10 7 4 1 1
Results:
4 7 1 10 7 4 1 1 -> 28
The corresponding full code is:
1 # Perl weekly challenge 234
2 # Task 2: Unequal Triplets
3 #
4 # See https://wlmb.github.io/2023/09/11/PWC234/#task-2-unequal-triplets
5 use v5.36;
6 use Algorithm::Combinatorics qw(combinations);
7 use List::Util qw(sum0 product);
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 N1 [N2...]
10 to count the number of unequal triplets in the set {N1 N2...}
11 FIN
12 my %count_for_number;
13 ++$count_for_number{$_} for @ARGV;
14 my @numbers=keys %count_for_number;
15 my $result=@numbers<3
16 ? 0
17 : sum0 map {
18 product @count_for_number{@$_}
19 } combinations(\@numbers,3);
20 say "@ARGV -> $result",
Examples:
./ch-2.pl 4 4 2 4 3
./ch-2.pl 1 1 1 1 1
./ch-2.pl 4 7 1 10 7 4 1 1
Results:
4 4 2 4 3 -> 3
1 1 1 1 1 -> 0
4 7 1 10 7 4 1 1 -> 28
Written on September 11, 2023