Perl Weekly Challenge 277.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 277.
Task 1: Count Common
Submitted by: Mohammad Sajid Anwar
You are given two array of strings, @words1 and @words2.
Write a script to return the count of words that appears in both arrays exactly once.
Example 1
Input: @words1 = ("Perl", "is", "my", "friend")
@words2 = ("Perl", "and", "Raku", "are", "friend")
Output: 2
The words "Perl" and "friend" appear once in each array.
Example 2
Input: @words1 = ("Perl", "and", "Python", "are", "very", "similar")
@words2 = ("Python", "is", "top", "in", "guest", "languages")
Output: 1
Example 3
Input: @words1 = ("Perl", "is", "imperative", "Lisp", "is", "functional")
@words2 = ("Crystal", "is", "similar", "to", "Ruby")
Output: 0
I can keep two hashes with counts for each word in each array. Then I
can grep the keys of any of these hashes by their count in both
arrays. I assume the inputs are in space separated strings in @ARGV. The results fits a 1.5liner.
Example 1:
perl -E '
for(@ARGV){$c[$i]{lc$_}++ for split " ", $_;$i++} say((map {"[$_]"} @ARGV), "->",
0+grep{$c[0]{$_}==$c[1]{$_}==1}keys %{$c[0]})
' "Perl is my friend" "Perl and Raku are friend"
Results:
[Perl is my friend][Perl and Raku are friend]->2
Example 2
perl -E '
for(@ARGV){$c[$i]{lc$_}++ for split " ", $_;$i++} say((map {"[$_]"} @ARGV), "->",
0+grep{$c[0]{$_}==$c[1]{$_}==1}keys %{$c[0]})
' "Perl and Python are very similar" "Python is top in guest languages"
Results:
[Perl and Python are very similar][Python is top in guest languages]->1
perl -E '
for(@ARGV){$c[$i]{lc$_}++ for split " ", $_;$i++} say 0+grep{$c[0]{$_}==$c[1]{$_}==1}keys %{$c[0]}
' "Perl is imperative Lisp is functional" "Crystal is similar to Ruby"
Results:
0
The full code is similar. I use for_list to deal with more than one
example at a time.
1 # Perl weekly challenge 277
2 # Task 1: Count Common
3 #
4 # See https://wlmb.github.io/2024/07/08/PWC277/#task-1-count-common
5 use v5.36;
6 use experimental qw(for_list);
7 die <<~"FIN" unless @ARGV and @ARGV%2==0;
8 Usage: $0 S11 S12 [S21 S22...]
9 to count pair of words that appear once in the space separated
10 strings Sn1 and Sn2.
11 FIN
12 for my ($s1, $s2)(@ARGV){
13 my @strings=($s1, $s2);
14 my @counts;
15 my $i=0;
16 for(@strings){
17 $counts[$i]{lc $_}++ for split " ", $_;
18 $i++;
19 }
20 say((map{"words$_ = [$strings[$_]] "}(0,1)), " -> ",
21 0+grep{$counts[0]{$_}==$counts[1]{$_}==1}keys %{$counts[0]});
22 }
Example:
./ch-1.pl "Perl is my friend" "Perl and Raku are friend" \
"Perl and Python are very similar" "Python is top in guest languages" \
"Perl is imperative Lisp is functional" "Crystal is similar to Ruby"
Results:
words0 = [Perl is my friend] words1 = [Perl and Raku are friend] -> 2
words0 = [Perl and Python are very similar] words1 = [Python is top in guest languages] -> 1
words0 = [Perl is imperative Lisp is functional] words1 = [Crystal is similar to Ruby] -> 0
Task 2: Strong Pair
Submitted by: Mohammad Sajid Anwar
You are given an array of integers, @ints.
Write a script to return the count of all strong pairs in the given array.
A pair of integers x and y is called strong pair if it satisfies:
0 < |x - y| < min(x, y).
Example 1
Input: @ints = (1, 2, 3, 4, 5)
Ouput: 4
Strong Pairs: (2, 3), (3, 4), (3, 5), (4, 5)
Example 2
Input: @ints = (5, 7, 1, 7)
Ouput: 1
Strong Pairs: (5, 7)
One solution is to generate all pairs and test their strength. The second example shows I have to get rid of repetitions first.
perl -MAlgorithm::Combinatorics=combinations -MList::Util=min,uniqnum -E '
@u=uniqnum(@ARGV); say "@ARGV -> ", 0+grep {0<abs($_->[1]-$_->[0])<min(@$_)}combinations(\@u,2)
' 1 2 3 4 5
Results:
1 2 3 4 5 -> 4
Results:
1 2 3 4 5 -> 4
perl -MAlgorithm::Combinatorics=combinations -MList::Util=min,uniqnum -E '
@u=uniqnum(@ARGV); say "@ARGV -> ", 0+grep {0<abs($_->[1]-$_->[0])<min(@$_)}combinations(\@u,2)
' 5 7 1 7
Results:
5 7 1 7 -> 1
The full code is:
1 # Perl weekly challenge 277
2 # Task 2: Strong Pair
3 #
4 # See https://wlmb.github.io/2024/07/08/PWC277/#task-2-strong-pair
5 use v5.36;
6 use Algorithm::Combinatorics qw(combinations);
7 use List::Util qw(min uniqnum);
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 N1 N2...
10 to count the number of strong pairs of numbers N1 N2...
11 FIN
12 my @uniq=uniqnum(@ARGV);
13 say "@ARGV -> ", 0+grep {0<abs($_->[1]-$_->[0])<min(@$_)}combinations(\@uniq,2);
Examples:
./ch-2.pl 1 2 3 4 5
./ch-2.pl 5 7 1 7
Results:
1 2 3 4 5 -> 4
5 7 1 7 -> 1
Written on July 8, 2024