Perl Weekly Challenge 249.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 249.
Task 1: Equal Pairs
Submitted by: Mohammad S Anwar
You are given an array of integers with even number of elements.
Write a script to divide the given array into equal pairs such that:
a. Each element belongs to exactly one pair.
b. The elements present in a pair are equal.
Example 1
Input: @ints = (3, 2, 3, 2, 2, 2)
Output: (2, 2), (3, 3), (2, 2)
There are 6 elements in @ints.
They should be divided into 6 / 2 = 3 pairs.
@ints is divided into the pairs (2, 2), (3, 3), and (2, 2) satisfying
all the conditions.
Example 2
Input: @ints = (1, 2, 3, 4)
Output: ()
There is no way to divide @ints 2 pairs such that the pairs satisfy
every condition.
I can count how many times each number appears and if all of them are even, output the corresponding pairs. This fits a one and a half liner.
Example 1:
perl -MList::Util=all -E '
$c{$_}++ for @ARGV; say "(@ARGV) => ", (all {$_%2==0} values %c)?
map {("($_ $_) ") x ($c{$_}/2)} keys %c:"()"
' 3 2 3 2 2 2
Results:
(3 2 3 2 2 2) => (2 2) (2 2) (3 3)
Example 2:
perl -MList::Util=all -E '
$c{$_}++ for @ARGV; say "(@ARGV) => ", (all {$_%2==0} values %c)?
map {("($_ $_) ") x ($c{$_}/2)} keys %c:"()"
' 1 2 3 4
Results:
(1 2 3 4) => ()
The full code is:
1 # Perl weekly challenge 249
2 # Task 1: Equal Pairs
3 #
4 # See https://wlmb.github.io/2023/12/25/PWC249/#task-1-equal-pairs
5 use v5.36;
6 use List::Util qw(all);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N1 [N2...]
9 to find pairs of equal numbers N_i == N_j
10 FIN
11 my %count;
12 $count{$_}++ for @ARGV;
13 say "(@ARGV) => ",
14 (all {$_%2==0} values %count)
15 ? map {("($_ $_) ") x ($count{$_}/2)} sort {$a<=>$b} keys %count:"()"
Examples:
./ch-1.pl 2 3 3 2 2 2
./ch-1.pl 1 2 3 4
Results:
(2 3 3 2 2 2) => (2 2) (2 2) (3 3)
(1 2 3 4) => ()
Task 2: DI String Match
Submitted by: Mohammad S Anwar
You are given a string s, consisting of only the characters "D" and "I".
Find a permutation of the integers [0 .. length(s)] such that for each
character s[i] in the string:
s[i] == 'I' ⇒ perm[i] < perm[i + 1]
s[i] == 'D' ⇒ perm[i] > perm[i + 1]
Example 1
Input: $str = "IDID"
Output: (0, 4, 1, 3, 2)
Example 2
Input: $str = "III"
Output: (0, 1, 2, 3)
Example 3
Input: $str = "DDI"
Output: (3, 2, 0, 1)
A simple solution is to start a sequence at 0, for every I increase update the maximum and append it to the sequence, and for every D decrease the minimum and append it to the sequence. Finally, subtract the minimum from all the elements. This yields a one and a half liner.
Examples:
perl -E '
for(@ARGV){my @o;push @o,$M=$m=0;push @o, ($_ eq "I")?++$M:--$m for split "";
say "$_ => (",join(",", map {$_-$m} @o), ")"}
' IDID III DDI
Results:
IDID => (2,3,1,4,0)
III => (0,1,2,3)
DDI => (2,1,0,3)
I believe these results are correct but they are not unique, and they don’t always agree with those shown in the description of the challenge. A similar solution may be obtained by reversing the string, the meaning of D and I and then reversing the result.
perl -E '
for(@ARGV){my @o;push @o,$M=$m=0;push @o, ($_ eq "D")?++$M:--$m for reverse split "";
say "$_ => (",join(",", reverse map {$_-$m} @o), ")"}
' IDID III DDI
Results:
IDID => (0,4,1,3,2)
III => (0,1,2,3)
DDI => (3,2,0,1)
The full code is:
1 # Perl weekly challenge 249
2 # Task 2: DI String Match
3 #
4 # See https://wlmb.github.io/2023/12/25/PWC249/#task-2-di-string-match
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 S1 [S2...]
8 where S_i is a string of D's and I's, to produce a permutation of
9 indices 0..length of S_i that increases or decreases according to
10 the letters D or I.
11 FIN
12 for(@ARGV){
13 warn("Only D's and I's allowed: $_"), next unless /^[DI]+$/;
14 my @output;
15 push @output,my $max=my $min=0;
16 push @output, ($_ eq "D")?++$max:--$min for reverse split "";
17 say "$_ => (",join(",", reverse map {$_-$min} @output), ")"
18 }
Examples:
./ch-2.pl IDID III DDI
Results:
IDID => (0,4,1,3,2)
III => (0,1,2,3)
DDI => (3,2,0,1)
/;