Perl Weekly Challenge 241.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 241.
Task 1: Arithmetic Triplets
Submitted by: Mohammad S Anwar
You are given an array (3 or more members) of integers in increasing order and a positive integer.
Write a script to find out the number of unique Arithmetic Triplets satisfying the following rules:
a. i < j < k
b. nums[j] - nums[i] == diff
c. nums[k] - nums[j] == diff
Example 1
Input: @nums = (0, 1, 4, 6, 7, 10)
$diff = 3
Output: 2
Index (1, 2, 4) is an arithmetic triplet because both 7 - 4 == 3 and 4 - 1 == 3.
Index (2, 4, 5) is an arithmetic triplet because both 10 - 7 == 3 and 7 - 4 == 3.
Example 2
Input: @nums = (4, 5, 6, 7, 8, 9)
$diff = 2
Output: 2
(0, 2, 4) is an arithmetic triplet because both 8 - 6 == 2 and 6 - 4 == 2.
(1, 3, 5) is an arithmetic triplet because both 9 - 7 == 2 and 7 - 5 == 2.
A simple somewhat inefficient solution is to simply generate all triplets,
filter them and count them. I assume the $diff and the @nums are
given in @ARGV This yields a oneliner.
Example 1:
perl -MAlgorithm::Combinatorics=combinations -E'
($d,@x)=@ARGV; say "Nums: @x, diff: $d -> ", 0+grep{@y=@$_; $y[1]-$y[0]==$y[2]-$y[1]==$d}combinations([@x],3)
' 3 0 1 4 6 7 10
Results:
Nums: 0 1 4 6 7 10, diff: 3 -> 2
Example 2:
perl -MAlgorithm::Combinatorics=combinations -E'
($d,@x)=@ARGV; say "Nums: @x, diff: $d -> ", 0+grep{@y=@$_; $y[1]-$y[0]==$y[2]-$y[1]==$d}combinations([@x],3)
' 2 4 5 6 7 8 9
Results:
Nums: 4 5 6 7 8 9, diff: 2 -> 2
The full code adds a few checks.
1 # Perl weekly challenge 241
2 # Task 1: Arithmetic Triplets
3 #
4 # See https://wlmb.github.io/2023/10/30/PWC241/#task-1-arithmetic-triplets
5 use v5.36;
6 use List::Util qw(all);
7 use Algorithm::Combinatorics qw(combinations);
8 die <<~"FIN" if @ARGV<2;
9 Usage: $0 D N0 [N1...]
10 to count the triplets taken from N0 N1... with difference D between succesive terms;
11 FIN
12 my $diff=shift;
13 my @sorted=sort {$a <=> $b} @ARGV;
14 die "Array should be ordered" unless all {$sorted[$_]==$ARGV[$_]} 0..@ARGV-1;
15 say "Nums: @sorted, diff: $diff -> ",
16 0+grep{$_->[1]-$_->[0]==$_->[2]-$_->[1]==$diff} combinations([@sorted],3)
Examples:
./ch-1.pl 3 0 1 4 6 7 10
./ch-1.pl 2 4 5 6 7 8 9
Results:
Nums: 0 1 4 6 7 10, diff: 3 -> 2
Nums: 4 5 6 7 8 9, diff: 2 -> 2
Task 2: Prime Order
Submitted by: Mohammad S Anwar
You are given an array of unique positive integers greater than 2.
Write a script to sort them in ascending order of the count of their prime factors, tie-breaking by ascending value.
Example 1
Input: @int = (11, 8, 27, 4)
Output: (11, 4, 8, 27)
Prime factors of 11 => 11
Prime factors of 4 => 2, 2
Prime factors of 8 => 2, 2, 2
Prime factors ja of 27 => 3, 3, 3
I need a routine to count the number of prime factors of each number,
to be used in the sorting routine. To that end I can use the factor routine from
Math::Prime::Util. This leads to a one-liner.
Example 1:
perl -MMath::Prime::Util=factor -E '
say join " ", @ARGV, "->", sort{factor($a)<=>factor($b) || $a <=> $b} @ARGV
' 11 8 27 4
Results:
11 8 27 4 -> 11 4 8 27
The full code is almost identical.
1 # Perl weekly challenge 241
2 # Task 2: Prime Order
3 #
4 # See https://wlmb.github.io/2023/10/30/PWC241/#task-2-prime-order
5 use v5.36;
6 use Math::Prime::Util qw(factor);
7 die <<~"FIN" unless @ARGV;
8 Usage: $0 N0 [N1...]
9 to order the numbers N0 N1 according to the number of factors and their value.
10 FIN
11 say join " ", @ARGV, "->", sort{factor($a)<=>factor($b) || $a <=> $b} @ARGV
Example:
./ch-2.pl 11 8 27 4
Results:
11 8 27 4 -> 11 4 8 27
Written on October 30, 2023