# Perl Weekly Challenge 277.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 277.

``````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  #
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
``````

``````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  #
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