Perl Weekly Challenge 303.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 303.
Task 1: 3-digits Even
Submitted by: Mohammad Sajid Anwar
You are given a list (3 or more) of positive integers, @ints.
Write a script to return all even 3-digits integers that can be formed
using the integers in the given list.
Example 1
Input: @ints = (2, 1, 3, 0)
Output: (102, 120, 130, 132, 210, 230, 302, 310, 312, 320)
Example 2
Input: @ints = (2, 2, 8, 8, 2)
Output: (222, 228, 282, 288, 822, 828, 882)
I can use tuples from Algorithms::Combinatorics to generate
all the orderings of three elements taken from the input array, and
then filter those that end in an even number. I should also filter out
those that start with 0, as they effectively have less than two
digits. I should finally remove repeated numbers, which I can do with
uniq from List::Util.
This fits a one-liner.
Example 1:
perl -MAlgorithm::Combinatorics=tuples -MList::Util=uniq -E '
say "@ARGV -> ", join ", ", uniq map {join "",@$_} grep {$_->[0]&&!($_->[2]%2)} tuples(\@ARGV,3)
' 2 1 3 0
Results:
2 1 3 0 -> 210, 230, 120, 132, 130, 102, 320, 312, 310, 302
Example 2:
perl -MAlgorithm::Combinatorics=tuples -MList::Util=uniq -E '
say "@ARGV -> ", join ", ", uniq map {join "",@$_} grep {$_->[0]&&!($_->[2]%2)} tuples(\@ARGV,3)
' 2 2 8 8 2
Results:
2 2 8 8 2 -> 228, 222, 282, 288, 822, 828, 882
The corresponding full code adds a few checks:
1 # Perl weekly challenge 303
2 # Task 1: 3-digits Even
3 #
4 # See https://wlmb.github.io/2025/01/06/PWC303/#task-1-3-digits-even
5 use v5.36;
6 use Algorithm::Combinatorics qw(tuples);
7 use List::Util qw(uniq);
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 N1 N2...
10 to build all uniq three digit even numbers from the digits of the number Ni
11 FIN
12 for(@ARGV){
13 die "Expected three or more digits: $_" unless $_=~/^\d{3,}$/;
14 my @digits=sort {$a <=> $b} split "";
15 my @result=uniq map {join "",@$_} grep {$_->[0]&&!($_->[2]%2)} tuples(\@digits,3);
16 say "$_ -> @result";
17 }
Examples:
./ch-1.pl 2130 22882
Results:
2130 -> 102 120 130 132 210 230 302 310 312 320
22882 -> 222 228 282 288 822 828 882
Task 2: Delete and Earn
Submitted by: Mohammad Sajid Anwar
You are given an array of integers, @ints.
Write a script to return the maximum number of points you can
earn by applying the following operation some number of times.
Pick any ints[i] and delete it to earn ints[i] points.
Afterwards, you must delete every element equal to ints[i] - 1
and every element equal to ints[i] + 1.
Example 1
Input: @ints = (3, 4, 2)
Output: 6
Delete 4 to earn 4 points, consequently, 3 is also deleted.
Finally delete 2 to earn 2 points.
Example 2
Input: @ints = (2, 2, 3, 3, 3, 4)
Output: 9
Delete a 3 to earn 3 points. All 2's and 4's are also deleted too.
Delete a 3 again to earn 3 points.
Delete a 3 once more to earn 3 points.
If there were no repeated numbers, then I could simply reverse sort them and pick repeatedly the largest of the remaining numbers. If there are repeated numbers, I would have to order them according to the total gain of picking a given number vs. the total loss due to the removal of all instances of the two nearest neighbor numbers. After removing a number, I could remove all its remaining repetitions, with the corresponding gain and with no cost. The code fits a two-liner.
Example 1
perl -MList::UtilsBy=max_by -E '
$f{$_}++ for @ARGV;while(@l=keys %f){$m=max_by{g($_) - g($_+1) - g($_-1)}@l;
$t+=$m;delete $f{$_}for ($m-1..$m+1)}say "@ARGV -> $t";sub g($x){$x*$f{$x}}
' 3 4 2
Results:
3 4 2 -> 6
Example 2
perl -MList::UtilsBy=max_by -E '
$f{$_}++ for @ARGV;while(@l=keys %f){$m=max_by{g($_) - g($_+1) - g($_-1)}@l;
$t+=g($m);delete $f{$_}for ($m-1..$m+1)}say "@ARGV -> $t";sub g($x){$x*$f{$x}}
' 2 2 3 3 3 4
Results:
2 2 3 3 3 4 -> 9
The corresponding full code is:
1 # Perl weekly challenge 303
2 # Task 2: Delete and Earn
3 #
4 # See https://wlmb.github.io/2025/01/06/PWC303/#task-2-delete-and-earn
5 use v5.36;
6 use List::UtilsBy qw(max_by);
7
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 N1 N2...
10 for computing the maximum earnings one can obtain by choosing
11 a number n from the set {N1, N2...}, earning its points and
12 deleting it and all instances of of n+1 and n-1, and repeating
13 until no numbers remain
14 FIN
15
16 my %freq; # hash of frequencies
17 $freq{$_}++ for @ARGV; # count appearances of each number
18
19 my $total = 0;
20 while(my @keys=keys %freq){
21 # maximize the gain after subtracting the loss of potential gains.
22 my $choice = max_by {gain($_) - gain($_+1) - gain($_-1)} @keys;
23 $total += gain($choice);
24 delete $freq{$_} for ($choice-1..$choice+1);
25 }
26
27 say "@ARGV -> $total";
28
29 sub gain($x){ # gain from choosing all the numbers $x
30 $x*($freq{$x}//0);
31 }
Example:
./ch-2.pl 3 4 2
./ch-2.pl 2 2 3 3 3 4
Results:
3 4 2 -> 6
2 2 3 3 3 4 -> 9
/;