# Perl Weekly Challenge 241.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 241.

``````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  #
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
``````

``````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  #
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