Merge pull request #1101 from rjt-pl/rjt_041

Week 41 solutions and blogs

6 files changed, 154 insertions, 0 deletions

diff --git a/challenge-041/ryan-thompson/blog.txt b/challenge-041/ryan-thompson/blog.txt
new file mode 100644
index 0000000000..4a00b6ea62
--- /dev/null
+++ b/challenge-041/ryan-thompson/blog.txt
@@ -0,0 +1 @@
+http://www.ry.ca/2020/01/attractive-numbers/
diff --git a/challenge-041/ryan-thompson/blog1.txt b/challenge-041/ryan-thompson/blog1.txt
new file mode 100644
index 0000000000..32f48692c5
--- /dev/null
+++ b/challenge-041/ryan-thompson/blog1.txt
@@ -0,0 +1 @@
+http://www.ry.ca/2020/01/leonardo-numbers/
diff --git a/challenge-041/ryan-thompson/perl5/ch-1.pl b/challenge-041/ryan-thompson/perl5/ch-1.pl
new file mode 100755
index 0000000000..50418677b7
--- /dev/null
+++ b/challenge-041/ryan-thompson/perl5/ch-1.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/env perl
+#
+# ch-1.pl - Attractive numbers, done badly!
+#
+# Ryan Thompson <rjt@cpan.org>
+
+use 5.010;
+use warnings;
+use strict;
+no warnings 'uninitialized';
+
+# Here is how I'd normally tackle this problem:
+# use Math::Prime::Util ':all';
+# say for grep { is_prime( factor($_) ) } 1..50;
+
+my @primes50   = primes_to(50);
+my %primes50   = map  { $_ => 1 } @primes50;
+my @attractive = grep { $primes50{ prime_div_mult($_) } } 1..50;
+
+say for @attractive;
+
+# Check our results against https://oeis.org/A063989
+if ($ARGV[0] eq '--test') {
+    use Test::More;
+    my @oeis = (4, 6, 8, 9, 10, 12, 14, 15, 18, 20, 21, 22, 25, 26, 27, 28,
+                30, 32, 33, 34, 35, 38, 39, 42, 44, 45, 46, 48, 49, 50);
+    is_deeply \@attractive, \@oeis, "Matches published sequence";
+    done_testing;
+}
+
+# Unmodified Wilson's theorem is terrible, unless you only need tiny primes!
+# Please, I beg you, use Math::Prime::Util or similar in any real code. :-)
+# N is prime iff (N - 1)! % N == 0
+sub primes_to {
+    use bigint;
+    my $N = shift;
+    my $fac = 1;
+    my @r;
+    for my $n (2..$N) {
+        $fac *= $n - 1;
+
+        push @r, $n unless ($fac + 1) % $n;
+    }
+
+    @r;
+}
+
+# Get prime divisors in multiplicity (e.g., 48 = 2, 2, 2, 2, 3)
+sub prime_div_mult {
+    my $n = shift;
+    my @div;
+    for my $div (@primes50) {
+        last if $div > $n;
+        while ($n % $div == 0) {
+            $n /= $div;
+            push @div, $div;
+        }
+    }
+
+    @div;
+}
diff --git a/challenge-041/ryan-thompson/perl5/ch-2.pl b/challenge-041/ryan-thompson/perl5/ch-2.pl
new file mode 100755
index 0000000000..8026469c82
--- /dev/null
+++ b/challenge-041/ryan-thompson/perl5/ch-2.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/env perl
+#
+# ch-2.pl - Leonardo numbers
+#
+# Ryan Thompson <rjt@cpan.org>
+
+use 5.010;
+use warnings;
+use strict;
+use Memoize; # This is a core module
+
+# Use core Perl module "Memoize" to store results of previous calls
+# Note this is the exact same code as leo_no_memo, apart from the memoize call
+sub leo_memoize {
+    my $n = shift;
+    return 1 if $n < 2;
+    1 + leo_memoize($n - 1) + leo_memoize($n - 2);
+}
+memoize 'leo_memoize';
+
+# In this case doing memoization ourselves is really easy, and turns out
+# to be a surprising 777% faster than Memoize, so it's my preference.
+{
+    my @leo = (1, 1);
+    sub leo_my_memo {
+        my $n = shift;
+        $leo[$n] //= 1 + leo_my_memo($n - 1) + leo_my_memo($n - 2);
+    }
+}
+
+# Building up the list iteratively is also a good solution
+sub leo_to_n {
+    my @r = (1, 1);
+    push @r, $r[-1] + $r[-2] + 1 for 2..$_[0];
+    @r;
+}
+
+say for leo_to_n(20);
diff --git a/challenge-041/ryan-thompson/perl6/ch-1.p6 b/challenge-041/ryan-thompson/perl6/ch-1.p6
new file mode 100644
index 0000000000..3366103d7f
--- /dev/null
+++ b/challenge-041/ryan-thompson/perl6/ch-1.p6
@@ -0,0 +1,32 @@
+#!/usr/bin/env perl6
+
+# ch-1.p6 - Attractive numbers
+#
+# Ryan Thompson <rjt@cpan.org>
+
+sub MAIN( Int :$max = 50 ) {
+    .say for (1..$max).grep: *.divisors.is-prime;
+}
+
+# WARNING: `augment' has global scope
+# https://docs.perl6.org/syntax/augment
+# I'm using it here to demonstrate a unique language feature.
+
+use MONKEY-TYPING;
+
+augment class Int {
+
+    #| Return an Array of prime divisors (with multiplicity)
+    method divisors returns Array {
+        my @div;
+        my $n = self;
+        for (2..self.sqrt).grep: *.is-prime -> $div {
+            while $n % $div == 0 {
+                $n /= $div;
+                @div.push: $div;
+            }
+        }
+        @div;
+    }
+
+}
diff --git a/challenge-041/ryan-thompson/perl6/ch-2.p6 b/challenge-041/ryan-thompson/perl6/ch-2.p6
new file mode 100644
index 0000000000..4e2c2c0104
--- /dev/null
+++ b/challenge-041/ryan-thompson/perl6/ch-2.p6
@@ -0,0 +1,21 @@
+#!/usr/bin/env perl6
+
+# ch-2.p6 - Leonardo numbers
+#
+# Ryan Thompson <rjt@cpan.org>
+
+use experimental :cached;
+
+# Cached version
+sub leo( Int $n ) is cached { $n < 2 ?? 1 !! 1 + leo($n - 1) + leo($n - 2) }
+
+# Manually memoized solution
+sub leo_my_memo( Int $n ) {
+    state @leo = (1, 1);
+    @leo[$n] //= 1 + leo_my_memo($n - 1) + leo_my_memo($n - 2);
+}
+
+# Lazily evaluated version
+my @leo = 1, 1, 1+*+* ... ∞;
+
+.say for @leo[0..20];