Perl Weekly Challenge 244.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 244.
Task 1: Count Smaller
Submitted by: Mohammad S Anwar
You are given an array of integers.
Write a script to calculate the number of integers
smaller than the integer at each index.
Example 1
Input: @int = (8, 1, 2, 2, 3)
Output: (4, 0, 1, 1, 3)
For index = 0, count of elements less 8 is 4.
For index = 1, count of elements less 1 is 0.
For index = 2, count of elements less 2 is 1.
For index = 3, count of elements less 2 is 1.
For index = 4, count of elements less 3 is 3.
Example 2
Input: @int = (6, 5, 4, 8)
Output: (2, 1, 0, 3)
Example 3
Input: @int = (2, 2, 2)
Output: (0, 0, 0)
To count integers smaller than n
I first identify the previous integer,
m
. Then, the result is recursively given by the number of times m
appears plus the number of integers smaller than m
(or 0 if m
doesn’t exist). I first sort the entries to facilitate identifying the
previous integer. The result fits a 1.5 liner.
Example 1:
perl -E '
for(@s= sort{$a <=>$b} @a=@ARGV){$e{$_}++; $p==$_ || ($p{$_}=$p); $p=$_}
$t{$_}=$e{$p{$_}}+$t{$p{$_}} for @s; say "@a -> @t{@a}"
' 8 1 2 2 3
Results:
8 1 2 2 3 -> 4 0 1 1 3
Example 2:
perl -E '
for(@s= sort{$a <=>$b} @a=@ARGV){$e{$_}++; $p==$_ || ($p{$_}=$p); $p=$_}
$t{$_}=$e{$p{$_}}+$t{$p{$_}} for @s; say "@a -> @t{@a}"
' 6 5 4 8
Results:
6 5 4 8 -> 2 1 0 3
Example 3:
perl -E '
for(@s= sort{$a <=>$b} @a=@ARGV){$e{$_}++; $p==$_ || ($p{$_}=$p); $p=$_}
$t{$_}=$e{$p{$_}}+$t{$p{$_}} for @s; say "@a -> @t{@a}"
' 2 2 2
Results:
2 2 2 -> 0 0 0
The full code follows:
1 # Perl weekly challenge 244
2 # Task 1: Count Smaller
3 #
4 # See https://wlmb.github.io/2023/11/20/PWC244/#task-1-count-smaller
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... are smaller
9 than each element
10 FIN
11 my @sorted = sort{$a <=>$b} @ARGV;
12 my %repetitions;
13 my %previous;
14 my $previous;
15 for(@sorted){
16 $repetitions{$_}++;
17 $previous{$_} = $previous unless defined $previous && $previous==$_;
18 $previous = $_;
19 }
20 my %total;
21 for(@sorted){
22 $total{$_}=0 unless defined $previous{$_};
23 $total{$_}=$repetitions{$previous{$_}}+$total{$previous{$_}} if defined $previous{$_};
24 }
25 say "@ARGV -> @total{@ARGV}"
Examples:
./ch-1.pl 8 1 2 2 3
./ch-1.pl 6 5 4 8
./ch-1.pl 2 2 2
Results:
8 1 2 2 3 -> 4 0 1 1 3
6 5 4 8 -> 2 1 0 3
2 2 2 -> 0 0 0
Task 2: Group Hero
Submitted by: Mohammad S Anwar
You are given an array of integers representing the strength.
Write a script to return the sum of the powers of all possible
combinations; power is defined as the square of the largest number
in a sequence, multiplied by the smallest.
Example 1
Input: @nums = (2, 1, 4)
Output: 141
Group 1: (2) => square(max(2)) * min(2) => 4 * 2 => 8
Group 2: (1) => square(max(1)) * min(1) => 1 * 1 => 1
Group 3: (4) => square(max(4)) * min(4) => 16 * 4 => 64
Group 4: (2,1) => square(max(2,1)) * min(2,1) => 4 * 1 => 4
Group 5: (2,4) => square(max(2,4)) * min(2,4) => 16 * 2 => 32
Group 6: (1,4) => square(max(1,4)) * min(1,4) => 16 * 1 => 16
Group 7: (2,1,4) => square(max(2,1,4)) * min(2,1,4) => 16 * 1 => 16
Sum: 8 + 1 + 64 + 4 + 32 + 16 + 16 => 141
I use subsets
from Algorithm::Combinatorics
to generate all
possible combinations of every possible length of the input array (as
there may be repetitions, they are not actually subsets). I use min
and max
from List::Util
. The result fits a simple oneliner.
Example 1:
perl -MAlgorithm::Combinatorics=subsets -MList::Util=min,max -E '
for(subsets(\@ARGV)){$t+= max(@$_)**2*min(@$_) if @$_} say "@ARGV -> $t";
' 2 1 4
Results:
2 1 4 -> 141
The full code follows:
1 # Perl weekly challenge 244
2 # Task 2: Group Hero
3 #
4 # See https://wlmb.github.io/2023/11/20/PWC244/#task-2-group-hero
5 use v5.36;
6 use Algorithm::Combinatorics qw(subsets);
7 use List::Util qw(min max);
8 die <<~"FIN" unless @ARGV;
9 Usage: $0 N1 [N2...]
10 to obtain the sum of the /powers/ of all combinations of all sizes
11 of elements of the list N1 N2..
12 FIN
13 my $subsets=subsets(\@ARGV);
14 my $total=0;
15 while(my $subset=$subsets->next){
16 $total+= max(@$subset)**2*min(@$subset) if @$subset
17 }
18 say "@ARGV -> $total";
Example:
./ch-2.pl 2 1 4
Results:
2 1 4 -> 141