Perl Weekly Challenge 222.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 222.
Task 1: Matching Members
Submitted by: Mohammad S Anwar
You are given a list of positive integers, @ints.
Write a script to find the total matching members after sorting the list increasing order.
Example 1
Input: @ints = (1, 1, 4, 2, 1, 3)
Output: 3
Original list: (1, 1, 4, 2, 1, 2)
Sorted list : (1, 1, 1, 2, 3, 4)
Compare the two lists, we found 3 matching members (1, 1, 2).
Example 2
Input: @ints = (5, 1, 2, 3, 4)
Output: 0
Original list: (5, 1, 2, 3, 4)
Sorted list : (1, 2, 3, 4, 5)
Compare the two lists, we found 0 matching members.
Example 3
Input: @ints = (1, 2, 3, 4, 5)
Output: 5
Original list: (1, 2, 3, 4, 5)
Sorted list : (1, 2, 3, 4, 5)
Compare the two lists, we found 5 matching members.
We can simply follow instructions: sort the input array, filter its indices by comparing the sorted and unsorted versions and count them. This yields a short oneliner:
perl -E '@s=sort {$a<=>$b} @i=@ARGV; @o=grep {$s[$_]==$i[$_]}0..@i-1; say "@i -> ", 0+@o' 1 1 4 2 1 3
Results:
1 1 4 2 1 3 -> 3
Other examples:
perl -E '@s=sort {$a<=>$b} @i=@ARGV; @o=grep {$s[$_]==$i[$_]}0..@i-1; say "@i -> ", 0+@o' 5 1 2 3 4
perl -E '@s=sort {$a<=>$b} @i=@ARGV; @o=grep {$s[$_]==$i[$_]}0..@i-1; say "@i -> ", 0+@o' 1 2 3 4 5
Results:
5 1 2 3 4 -> 0
1 2 3 4 5 -> 5
The full code is almost identical.
1 # Perl weekly challenge 222
2 # Task 1: Matching Members
3 #
4 # See https://wlmb.github.io/2023/06/19/PWC222/#task-1-matching-members
5 use v5.36;
6 die <<~"FIN" unless @ARGV;
7 Usage: $0 N1 [N2....]
8 to count how many members of the list N1 N2... match the members of the
9 corresponding sorted list
10 FIN
11 my @sorted=sort {$a<=>$b} my @in=@ARGV;
12 my @out=grep {$sorted[$_]==$in[$_]} 0..@in-1;
13 say "@in -> ", 0+@out;
Examples:
./ch-1.pl 1 1 4 2 1 3
./ch-1.pl 5 1 2 3 4
./ch-1.pl 1 2 3 4 5
Results:
1 1 4 2 1 3 -> 3
5 1 2 3 4 -> 0
1 2 3 4 5 -> 5
Task 2: Last Member
Submitted by: Mohammad S Anwar
You are given an array of positive integers, @ints.
Write a script to find the last member if found otherwise return 0.
Each turn pick 2 biggest members (x, y) then decide based on the
following conditions, continue this until you are left with 1 member or none.
a. if x == y then remove both members
b. if x != y then remove both members and add new member (y-x)
Example 1:
Input: @ints = (2, 7, 4, 1, 8, 1)
Output: 1
Step 1: pick 7 and 8, we remove both and add new member 1 => (2, 4, 1, 1, 1).
Step 2: pick 2 and 4, we remove both and add new member 2 => (2, 1, 1, 1).
Step 3: pick 2 and 1, we remove both and add new member 1 => (1, 1, 1).
Step 4: pick 1 and 1, we remove both => (1).
Example 2:
Input: @ints = (1)
Output: 1
Example 3:
Input: @ints = (1, 1)
Output: 0
Step 1: pick 1 and 1, we remove both and we left with none.
To solve this challenge, I first sort the numbers in descending order, chose the first two, subtract them, splice at appropriate position if positive (doing a dumb search) and repeat until only one or zero numbers remain. This fits a two-liner:
perl -MList::Util=first -E '
@l=sort {$b<=>$a}@ARGV; while(@l>1){($x, $y)=splice @l,0,2; next unless $x-=$y;
$i=(first {$l[$_]<=$x} 0..@l-1)//@l+1; splice @l,$i,0,$x;} say "@ARGV->", $l[0]//0
' 2 7 4 1 8 1
Results:
2 7 4 1 8 1->1
Other examples:
perl -MList::Util=first -E '
@l=sort {$b<=>$a}@ARGV; while(@l>1){($x, $y)=splice @l,0,2; next unless $x-=$y;
$i=(first {$l[$_]<=$x} 0..@l-1)//@l+1; splice @l,$i,0,$x;} say "@ARGV->", $l[0]//0
' 1
perl -MList::Util=first -E '
@l=sort {$b<=>$a}@ARGV; while(@l>1){($x, $y)=splice @l,0,2; next unless $x-=$y;
$i=(first {$l[$_]<=$x} 0..@l-1)//@l+1; splice @l,$i,0,$x;} say "@ARGV->", $l[0]//0
' 1 1
perl -MList::Util=first -E '
@l=sort {$b<=>$a}@ARGV; while(@l>1){($x, $y)=splice @l,0,2; next unless $x-=$y;
$i=(first {$l[$_]<=$x} 0..@l-1)//@l+1; splice @l,$i,0,$x;} say "@ARGV->", $l[0]//0
' 8 7 2
Results:
1->1
1 1->0
8 7 2->1
The full code is similar:
1 # Perl weekly challenge 222
2 # Task 2: Last Member
3 #
4 # See https://wlmb.github.io/2023/06/19/PWC222/#task-2-last-member
5 use v5.36;
6 use List::Util qw(first all);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N1 [N2...]
9 to find last member from list N1 N2...
10 after iteratively eliminating equal pairs
11 and replacing unequal pairs by their differences,
12 starting from the highest values.
13 FIN
14 # If non-positive are allowed, the result 0 becomes ambiguous.
15 # Not necessary to check for integers, though.
16 die "Expected positive numbers" unless all {$_>0} @ARGV;
17 my @list = sort {$b <=> $a} @ARGV;
18 while(@list>1){
19 my ($x, $y)=splice @list, 0, 2; # Remove largest two elements.
20 next unless $x-=$y; # Were they equal?
21 my $i=(first {$list[$_]<=$x} 0..@list - 1) // @list + 1; # No. Fin where to insert difference
22 splice @list, $i, 0, $x;
23 }
24 say "@ARGV->", $list[0]//0; # Print single remaining element or 0 if none.
Examples:
./ch-2.pl 2 7 4 1 8 1
./ch-2.pl 1
./ch-2.pl 1 1
Results:
2 7 4 1 8 1->1
1->1
1 1->0
Written on June 19, 2023