From 8166aa7634116587a1670bb4909b18061b7b8b72 Mon Sep 17 00:00:00 2001
From: Niels van Dijke <perlboy@cpan.org>
Date: Mon, 30 Oct 2023 23:12:11 +0000
Subject: w241 - Task 1 & 2

---
 challenge-241/perlboy1967/perl/ch1.pl | 46 ++++++++++++++++++++++++++++++++
 challenge-241/perlboy1967/perl/ch2.pl | 50 +++++++++++++++++++++++++++++++++++
 2 files changed, 96 insertions(+)
 create mode 100755 challenge-241/perlboy1967/perl/ch1.pl
 create mode 100755 challenge-241/perlboy1967/perl/ch2.pl

diff --git a/challenge-241/perlboy1967/perl/ch1.pl b/challenge-241/perlboy1967/perl/ch1.pl
new file mode 100755
index 0000000000..dacf68a262
--- /dev/null
+++ b/challenge-241/perlboy1967/perl/ch1.pl
@@ -0,0 +1,46 @@
+#!/bin/perl
+
+=pod
+
+The Weekly Challenge - 241
+- https://theweeklychallenge.org/blog/perl-weekly-challenge-241
+
+Author: Niels 'PerlBoy' van Dijke
+
+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
+
+=cut
+
+use v5.32;
+use common::sense;
+
+use Test2::V0;
+
+sub nArithmeticTriplets (\@$) {
+  my ($arL,$diff) = @_;
+  my $n = 0;
+
+  for my $i (0 .. $arL->$#* - 2) {
+    for my $j ($i + 1 .. $arL->$#* - 1) {
+      for my $k ($j + 1 .. $arL->$#*) {
+        $n++ if ($$arL[$j] - $$arL[$i] == $diff == $$arL[$k] - $$arL[$j]);
+      }
+    }
+  }
+
+  return $n;
+}
+
+is(nArithmeticTriplets(@{[0,1,4,6,7,10]},3), 2);
+is(nArithmeticTriplets(@{[4,5,6,7,8,9]},2), 2);
+
+done_testing;
diff --git a/challenge-241/perlboy1967/perl/ch2.pl b/challenge-241/perlboy1967/perl/ch2.pl
new file mode 100755
index 0000000000..98663433a0
--- /dev/null
+++ b/challenge-241/perlboy1967/perl/ch2.pl
@@ -0,0 +1,50 @@
+#!/bin/perl
+
+=pod
+
+The Weekly Challenge - 241
+- https://theweeklychallenge.org/blog/perl-weekly-challenge-241
+
+Author: Niels 'PerlBoy' van Dijke
+
+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.
+
+=cut
+
+use v5.32;
+use common::sense;
+
+use Math::Prime::Util qw(factor);
+
+use Test2::V0;
+
+sub _cmpLists (\@\@) {
+  my $r = 0;
+
+  for (1 .. $_[0]->$#*) {
+    $r = $_[0]->[$_] <=> $_[1]->[$_];
+    return $r if $r != 0;
+  }
+
+  return 0;
+}
+
+sub primeOrder (@) {
+  map { $_->[0] } sort { 
+    scalar(@$a) <=> scalar(@$b)
+                || 
+            _cmpLists(@{$a},@{$b}) 
+  } map { [$_, factor($_)] } @_;
+
+}
+
+is([primeOrder(11,8,27,4)],[11,4,8,27]);
+is([primeOrder(5,3,4,3,2)],[2,3,3,5,4]);
+
+done_testing;
-- 
cgit 


From 87661874e00dee9e0a2b2c1b6b71dd1c5eb6131e Mon Sep 17 00:00:00 2001
From: Niels van Dijke <perlboy@cpan.org>
Date: Mon, 30 Oct 2023 23:31:01 +0000
Subject: Task 2 - update test #2

---
 challenge-241/perlboy1967/perl/ch2.pl | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/challenge-241/perlboy1967/perl/ch2.pl b/challenge-241/perlboy1967/perl/ch2.pl
index 98663433a0..2d79bcd7ea 100755
--- a/challenge-241/perlboy1967/perl/ch2.pl
+++ b/challenge-241/perlboy1967/perl/ch2.pl
@@ -45,6 +45,6 @@ sub primeOrder (@) {
 }
 
 is([primeOrder(11,8,27,4)],[11,4,8,27]);
-is([primeOrder(5,3,4,3,2)],[2,3,3,5,4]);
+is([primeOrder(15,3,4,2,12)],[2,3,4,15,12]);
 
 done_testing;
-- 
cgit 


From 0fe0a1dc5fb89146aca941a048be5572ff1cf222 Mon Sep 17 00:00:00 2001
From: Niels van Dijke <perlboy@cpan.org>
Date: Mon, 30 Oct 2023 23:50:47 +0000
Subject: Task2 - Optimized (borrowed some code from Egon Choroba)

---
 challenge-241/perlboy1967/perl/ch2a.pl | 39 ++++++++++++++++++++++++++++++++++
 1 file changed, 39 insertions(+)
 create mode 100755 challenge-241/perlboy1967/perl/ch2a.pl

diff --git a/challenge-241/perlboy1967/perl/ch2a.pl b/challenge-241/perlboy1967/perl/ch2a.pl
new file mode 100755
index 0000000000..f7063ddb4d
--- /dev/null
+++ b/challenge-241/perlboy1967/perl/ch2a.pl
@@ -0,0 +1,39 @@
+#!/bin/perl
+
+=pod
+
+The Weekly Challenge - 241
+- https://theweeklychallenge.org/blog/perl-weekly-challenge-241
+
+Author: Niels 'PerlBoy' van Dijke
+
+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.
+
+=cut
+
+use v5.32;
+use common::sense;
+
+use Math::Prime::Util qw(factor);
+
+use Test2::V0;
+
+sub primeOrder (@) {
+  map { $$_[0] } sort {
+    $a->$#* <=> $b->$#*
+            ||
+    $a->[0] <=> $b->[0]
+  } map { [$_, factor($_)] } @_;
+
+}
+
+is([primeOrder(11,8,27,4)],[11,4,8,27]);
+is([primeOrder(15,3,4,2,12)],[2,3,4,15,12]);
+
+done_testing;
-- 
cgit