Merge pull request #6282 from polettix/polettix/pwc169

Add polettix's solution to challenge-169

8 files changed, 182 insertions, 0 deletions

diff --git a/challenge-169/polettix/blog.txt b/challenge-169/polettix/blog.txt
new file mode 100644
index 0000000000..2b851a852e
--- /dev/null
+++ b/challenge-169/polettix/blog.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2022/06/15/pwc169-brilliant-numbers/
diff --git a/challenge-169/polettix/blog1.txt b/challenge-169/polettix/blog1.txt
new file mode 100644
index 0000000000..4293efdab8
--- /dev/null
+++ b/challenge-169/polettix/blog1.txt
@@ -0,0 +1 @@
+https://github.polettix.it/ETOOBUSY/2022/06/16/pwc169-achilles-numbers/
diff --git a/challenge-169/polettix/perl/ch-1.pl b/challenge-169/polettix/perl/ch-1.pl
new file mode 100644
index 0000000000..27a37d3ec3
--- /dev/null
+++ b/challenge-169/polettix/perl/ch-1.pl
@@ -0,0 +1,39 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+use ntheory qw< next_prime >;
+
+my $limit = shift // 20;
+my $it = primes_by_length_it();
+my @brilliants;
+while (@brilliants < $limit) {
+   push @brilliants, pairs_products($it->());
+}
+say join ', ', @brilliants[0 .. ($limit - 1)];
+
+sub pairs_products (@ns) {
+   my @products;
+   for my $i (0 .. $#ns) {
+      for my $j ($i .. $#ns) {
+         push @products, $ns[$i] * $ns[$j];
+      }
+   }
+   return sort { $a <=> $b } @products;
+}
+
+sub primes_by_length_it {
+   my $carry = 2;
+   my $length = 1;
+   return sub {
+      my @retval;
+      while (length($carry) == $length) {
+         push @retval, $carry;
+         $carry = next_prime($carry);
+      }
+      ++$length;
+      return @retval;
+   };
+}
diff --git a/challenge-169/polettix/perl/ch-2.pl b/challenge-169/polettix/perl/ch-2.pl
new file mode 100644
index 0000000000..fe37297538
--- /dev/null
+++ b/challenge-169/polettix/perl/ch-2.pl
@@ -0,0 +1,28 @@
+#!/usr/bin/env perl
+use v5.24;
+use warnings;
+use experimental 'signatures';
+no warnings 'experimental::signatures';
+
+use ntheory qw< factor_exp >;
+
+my $count = shift // 20;
+my @achilles;
+my $candidate = 72;
+while (@achilles < $count) {
+   push @achilles, $candidate if is_achilles($candidate);
+   ++$candidate;
+}
+say join ', ', @achilles;
+
+sub is_achilles ($n) {
+   my $gcd;
+   for my $pair (factor_exp($n)) {
+      my $power = $pair->[1];
+      return 0 if $power == 1;
+      $gcd = $gcd ? gcd($gcd, $power) : $power;
+   }
+   return $gcd == 1;
+}
+
+sub gcd ($A, $B) { ($A, $B) = ($B % $A, $A) while $A; return $B }
diff --git a/challenge-169/polettix/perl/cpanfile b/challenge-169/polettix/perl/cpanfile
new file mode 100644
index 0000000000..94ac365d6f
--- /dev/null
+++ b/challenge-169/polettix/perl/cpanfile
@@ -0,0 +1 @@
+requires 'ntheory';
diff --git a/challenge-169/polettix/perl/cpanfile.snapshot b/challenge-169/polettix/perl/cpanfile.snapshot
new file mode 100644
index 0000000000..2fd600a3af
--- /dev/null
+++ b/challenge-169/polettix/perl/cpanfile.snapshot
@@ -0,0 +1,38 @@
+# carton snapshot format: version 1.0
+DISTRIBUTIONS
+  Math-Prime-Util-0.73
+    pathname: D/DA/DANAJ/Math-Prime-Util-0.73.tar.gz
+    provides:
+      Math::Prime::Util 0.73
+      Math::Prime::Util::ChaCha 0.73
+      Math::Prime::Util::Entropy 0.73
+      Math::Prime::Util::MemFree 0.73
+      Math::Prime::Util::PP 0.73
+      Math::Prime::Util::PrimeArray 0.73
+      Math::Prime::Util::PrimeIterator 0.73
+      ntheory 0.73
+    requirements:
+      Carp 0
+      Config 0
+      Exporter 5.57
+      ExtUtils::MakeMaker 0
+      Math::BigFloat 1.59
+      Math::BigInt 1.88
+      Math::Prime::Util::GMP 0.50
+      Tie::Array 0
+      XSLoader 0.01
+      base 0
+      constant 0
+      perl 5.006002
+  Math-Prime-Util-GMP-0.52
+    pathname: D/DA/DANAJ/Math-Prime-Util-GMP-0.52.tar.gz
+    provides:
+      Math::Prime::Util::GMP 0.52
+    requirements:
+      Carp 0
+      Exporter 5.57
+      ExtUtils::MakeMaker 0
+      Fcntl 0
+      XSLoader 0.01
+      base 0
+      perl 5.006002
diff --git a/challenge-169/polettix/raku/ch-1.raku b/challenge-169/polettix/raku/ch-1.raku
new file mode 100644
index 0000000000..c5c48b8a0e
--- /dev/null
+++ b/challenge-169/polettix/raku/ch-1.raku
@@ -0,0 +1,19 @@
+#!/usr/bin/env raku
+use v6;
+sub MAIN (Int:D $limit where * > 0 = 20) {
+   my $length = 1;
+   my @brilliants;
+   while @brilliants < $limit {
+      @brilliants.push: pairs-products(primes-of-length($length++)).Slip;
+   }
+   put @brilliants[0 ..^ $limit].join(', ');
+}
+
+sub pairs-products (@ns) {
+   (@ns X @ns).grep({[<=] $_}).map({[*] $_}).sort;
+}
+
+sub primes-of-length (Int:D $n where * > 0) {
+   my $lo = [*] 10 xx ($n - 1);
+   ($lo .. $lo * 10).grep({.is-prime}).Array;
+}
diff --git a/challenge-169/polettix/raku/ch-2.raku b/challenge-169/polettix/raku/ch-2.raku
new file mode 100644
index 0000000000..b57f485363
--- /dev/null
+++ b/challenge-169/polettix/raku/ch-2.raku
@@ -0,0 +1,55 @@
+#!/usr/bin/env raku
+use v6;
+sub MAIN (Int:D $count where * > 0 = 20) {
+   my @achilles;
+   my $candidate = 72;
+   while @achilles < $count {
+      @achilles.push: $candidate if is-achilles($candidate);
+      ++$candidate;
+   }
+   put @achilles.join(', ');
+}
+
+sub is-achilles ($n) {
+   my $gcd;
+   for factor_exp($n) -> ($p, $power) {
+      return False if $power == 1;
+      $gcd = $gcd ?? gcd($gcd, $power) !! $power;
+   }
+   return $gcd == 1;
+}
+
+sub gcd ($A is copy, $B is copy) {
+   ($A, $B) = ($B % $A, $A) while $A;
+   return $B;
+}
+
+sub factor_exp (Int $n) {
+   my @retval = [0, 0],;
+   for factors($n) -> $p {
+      if $p == @retval[*-1][0] { @retval[*-1][1]++ }
+      else                     { @retval.push: [$p, 1] }
+   }
+   @retval.shift;
+   return @retval;
+}
+
+sub factors (Int $remainder is copy) {
+   return 1 if $remainder <= 1;
+   state @primes = 2, 3, 5, -> $n is copy {
+      repeat { $n += 2 } until $n %% none @primes ... { $_ * $_ >= $n }
+      $n;
+   } ... *;
+   gather for @primes -> $factor {
+      if $factor * $factor > $remainder {
+         take $remainder if $remainder > 1;
+         last;
+      }
+
+      # How many times can we divide by this prime?
+      while $remainder %% $factor {
+         take $factor;
+         last if ($remainder div= $factor) === 1;
+      }
+   }
+}