Perl Weekly Challenge 256.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 256.
Task 1: Maximum Pairs
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 #
4 # See https://wlmb.github.io/2024/02/12/PWC256/#task-1-maximum-pairs
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 #
4 # See https://wlmb.github.io/2024/02/12/PWC256/#task-1-maximum-pairs
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
Task 2: Merge Strings
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 #
4 # See https://wlmb.github.io/2024/02/12/PWC256/#task-2-merge-strings
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