# Perl Weekly Challenge 256.

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

``````Submitted by: Mohammad Sajid Anwar
You are given an array of distinct words, @words.

Write a script to find the maximum pairs in the given array.
The words \$words[i] and \$words[j] can be a pair one is reverse of the other.

Example 1
Input: @words = ("ab", "de", "ed", "bc")
Output: 1

There is one pair in the given array: "de" and "ed"
Example 2
Input: @words = ("aa", "ba", "cd", "ed")
Output: 0
Example 3
Input: @words = ("uv", "qp", "st", "vu", "mn", "pq")
Output: 2
``````

A solution could be obtained by keeping a hash for counting each word and its reverse, incrementing it for each word found and decrementing it for each reverse found. Then, the number of pairs is one half the number of resulting zeroes, assumming each word can be paired with at most one other word. I have to take precautions for not pairing a symmetric word with itself. This yields a one-liner.

Example 1:

``````perl -MList::Util=sum0 -E  '
++\$c{\$_}, \$_ ne (\$x= reverse \$_)&& --\$c{\$x} for @ARGV; say "@ARGV -> ", (sum0 map {!\$_} values %c)/2
' ab de ed bc
``````

Results:

``````ab de ed bc -> 1
``````

Example 2:

``````perl -MList::Util=sum0 -E  '
++\$c{\$_}, \$_ ne (\$x= reverse \$_)&& --\$c{\$x} for @ARGV; say "@ARGV -> ", (sum0 map {!\$_} values %c)/2
' aa ba cd ef
``````

Results:

``````aa ba cd ef -> 0
``````

Example 3:

``````perl -MList::Util=sum0 -E  '
++\$c{\$_}, \$_ ne (\$x= reverse \$_)&& --\$c{\$x} for @ARGV; say "@ARGV -> ", (sum0 map {!\$_} values %c)/2
' uv qp st vu mn pq
``````

Results:

``````uv qp st vu mn pq -> 2
``````

The problem with this code is that each word may be a part of more than one pair. Thus an alternative is to multiply the number of times a word appears by the number of times its reverse appears, add these numbers and divide by to to eliminate duplicates. I have to take care in the case where a word is equal to its reverse, as I shouldn’t pair a word with itself.

Examples:

``````perl -MList::Util=sum0 -E  '
++\$c{\$_} for @ARGV; say "@ARGV -> ", (sum0 map {\$c{\$_}*(\$c{\$x=reverse(\$_)}-(\$x eq \$_))} keys %c)/2
' ab de ed bc

perl -MList::Util=sum0 -E  '
++\$c{\$_} for @ARGV; say "@ARGV -> ", (sum0 map {\$c{\$_}*(\$c{\$x=reverse(\$_)}-(\$x eq \$_))} keys %c)/2
' aa ba cd ef

perl -MList::Util=sum0 -E  '
++\$c{\$_} for @ARGV; say "@ARGV -> ", (sum0 map {\$c{\$_}*(\$c{\$x=reverse(\$_)}-(\$x eq \$_))} keys %c)/2
' uv qp st vu mn pq
``````

Results:

``````ab de ed bc -> 1
aa ba cd ef -> 0
uv qp st vu mn pq -> 2
``````

Examples with multiple pairs:

``````perl -MList::Util=sum0 -E  '
++\$c{\$_} for @ARGV; say "@ARGV -> ", (sum0 map {\$c{\$_}*(\$c{\$x=reverse(\$_)}-(\$x eq \$_))} keys %c)/2
' de ed ed

perl -MList::Util=sum0 -E  '
++\$c{\$_} for @ARGV; say "@ARGV -> ", (sum0 map {\$c{\$_}*(\$c{\$x=reverse(\$_)}-(\$x eq \$_))} keys %c)/2
' aa aa aa

perl -MList::Util=sum0 -E  '
++\$c{\$_} for @ARGV; say "@ARGV -> ", (sum0 map {\$c{\$_}*(\$c{\$x=reverse(\$_)}-(\$x eq \$_))} keys %c)/2
' uv uv vu vu
``````

Results:

``````de ed ed -> 2
aa aa aa -> 3
uv uv vu vu -> 4
``````

The full code based in the first approach follows:

`````` 1  # Perl weekly challenge 256
2  # Task 1:  Maximum Pairs
3  #
5  use v5.36;
6  use List::Util qw(sum0);
7  die <<~"FIN" unless @ARGV;
8      Usage: \$0 S1 [S2...]
9      to pair Si with the reverse Sj and count the resulting pairs
10      assuming at most one pair per string.
11      FIN
12  my %count;
13  my \$reverse;
14  for (@ARGV){
15      ++\$count{\$_};
16      my \$reverse=reverse \$_;
17      --\$count{\$reverse} unless \$reverse eq \$_;
18  }
19  say "@ARGV -> ", (sum0 map {!\$_} values %count)/2;
``````

Examples:

``````./ch-1.pl ab de ed bc
./ch-1.pl aa ba cd ef
./ch-1.pl uv qp st vu mn pq
``````

Results:

``````ab de ed bc -> 1
aa ba cd ef -> 0
uv qp st vu mn pq -> 2
``````

The full code based in the second approach is:

`````` 1  # Perl weekly challenge 256
2  # Task 1:  Maximum Pairs
3  #
5  use v5.36;
6  use List::Util qw(sum0);
7  die <<~"FIN" unless @ARGV;
8      Usage: \$0 S1 [S2...]
9      to pair Si with the reverse Sj and count the resulting pairs
10      FIN
11  my %count;
12  ++\$count{\$_} for (@ARGV);
13  my \$result = (sum0 map {
14      my \$reverse=reverse \$_;
15      my \$selfreverse=\$_ eq \$reverse;
16      \$count{\$_}*((\$count{\$reverse}//0)-\$selfreverse)
17  } keys %count)/2;
18  say "@ARGV -> \$result";
``````

Examples:

``````./ch-1a.pl ab de ed bc
./ch-1a.pl aa ba cd ef
./ch-1a.pl uv qp st vu mn pq
./ch-1a.pl de ed ed
./ch-1a.pl aa aa aa
./ch-1a.pl uv uv vu vu
``````

Results:

``````ab de ed bc -> 1
aa ba cd ef -> 0
uv qp st vu mn pq -> 2
de ed ed -> 2
aa aa aa -> 3
uv uv vu vu -> 4
``````

``````Submitted by: Mohammad Sajid Anwar
You are given two strings, \$str1 and \$str2.

Write a script to merge the given strings by adding in alternative
order starting with the first string. If a string is longer than the
other then append the remaining at the end.

Example 1
Input: \$str1 = "abcd", \$str2 = "1234"
Output: "a1b2c3d4"
Example 2
Input: \$str1 = "abc", \$str2 = "12345"
Output: "a1b2c345"
Example 3
Input: \$str1 = "abcde", \$str2 = "123"
Output: "a1b2c3de"
``````

I split the inputs into two arrays and I call a routine alternatively on both to shift their elements and return them, or return empty strings if the given array is empty. I proceed until both arrays are empty and I concatenate the returned strings. This fits a one-liner.

Example 1:

``````perl -E '
sub f(\$x){shift @\$x||""}(\$x,\$y)=map{[split ""]}@ARGV;\$o.=f(\$x).f\$y while(@\$x||@\$y);say "@ARGV -> \$o"
' abcd 1234
``````

Results:

``````abcd 1234 -> a1b2c3d4
``````

Example 2:

``````perl -E '
sub f(\$x){shift @\$x||""}(\$x,\$y)=map{[split ""]}@ARGV;\$o.=f(\$x).f\$y while(@\$x||@\$y);say "@ARGV -> \$o"
' abc 12345
``````

Results:

``````abc 12345 -> a1b2c345
``````

Example 3:

``````perl -E '
sub f(\$x){shift @\$x||""}(\$x,\$y)=map{[split ""]}@ARGV;\$o.=f(\$x).f\$y while(@\$x||@\$y);say "@ARGV -> \$o"
' abcde 123
``````

Results:

``````abcde 123 -> a1b2c3de
``````

The full code is:

`````` 1  # Perl weekly challenge 256
2  # Task 2:  Merge Strings
3  #
5  use v5.36;
6  sub next_char(\$x){
7      shift @\$x||""
8  }
9  my (\$x,\$y)=map{[split ""]}@ARGV;
10  my \$out="";
11  \$out.=next_char(\$x) . next_char(\$y) while(@\$x||@\$y);
12  say "@ARGV -> \$out"
``````

Example:

``````./ch-2.pl abcd 1234
./ch-2.pl abc 12345
./ch-2.pl abcde 123
``````

Results:

``````abcd 1234 -> a1b2c3d4
abc 12345 -> a1b2c345
abcde 123 -> a1b2c3de
``````
Written on February 12, 2024