Merge pull request #5399 from jacoby/master

144

3 files changed, 91 insertions, 0 deletions

diff --git a/challenge-144/dave-jacoby/blog.txt b/challenge-144/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..c2963f5c71
--- /dev/null
+++ b/challenge-144/dave-jacoby/blog.txt
@@ -0,0 +1,2 @@
+https://jacoby.github.io/2021/12/20/almost-prime-and-in-sequence-the-weekly-challenge-144.html
+
diff --git a/challenge-144/dave-jacoby/perl/ch-1.pl b/challenge-144/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..24672bb570
--- /dev/null
+++ b/challenge-144/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,26 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say state postderef signatures };
+no warnings qw{ experimental };
+
+say join ', ', grep { is_semiprime($_) } 1 .. 100;
+
+sub is_semiprime ($n ) {
+    my $done;
+    return 0 if is_prime($n);
+    my @factors =
+        grep { !$done->{ $_->[0] }{ $_->[1] }++ }    # avoid replication
+        grep { is_prime( $_->[0] ) }                 # factor 1 is prime
+        grep { is_prime( $_->[1] ) }                 # factor 2 is prime
+        map  { [ sort $_, $n / $_ ] }                # both applicable factors
+        grep { 0 == $n % $_ }                        # is a factor
+        2 .. sqrt $n;
+    return scalar @factors == 1 ? 1 : 0;
+}
+
+sub is_prime ($n) {
+    for ( 2 .. sqrt $n ) { return unless $n % $_ }
+    return 1;
+}
diff --git a/challenge-144/dave-jacoby/perl/ch-2.pl b/challenge-144/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..93e98d9a72
--- /dev/null
+++ b/challenge-144/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,63 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say postderef signatures state };
+no warnings qw{ experimental };
+
+use JSON;
+my $json = JSON->new;
+
+my @examples;
+push @examples, [ 1, 2 ];
+push @examples, [ 2, 3 ];
+push @examples, [ 2, 5 ];
+push @examples, [ 5, 7 ];
+
+for my $x (@examples) {
+    say '-' x 20;
+    my ( $u, $v ) = $x->@*;
+    my @sequence = ulam( $u, $v );
+    my $sequence = join ', ', sort { $a <=> $b } @sequence;
+    say <<"END";
+    Input:   \$u = $u, \$v = $v
+    Output: $sequence
+END
+}
+
+sub ulam ( $u = 1, $v = 2 ) {
+    my %output;
+    my @output;
+
+    # cover the base cases
+    $output{$u} = 1;
+    $output{$v} = 1;
+
+    my ($c) = sort { $b <=> $a } $u, $v;
+    while (1) {
+        $c++;
+
+        # ensure that non-Ulam numbers ("exactly one way")
+        # get weeded out
+        map { delete $output{$_} } grep { $output{$_} > 1 }
+            keys %output;
+        @output = sort { $a <=> $b } keys %output;
+
+        # testing early, because of the filter
+        return @output if scalar @output == 10;
+
+        for my $i ( 0 .. -2 + scalar @output ) {
+            my $x = $output[$i];
+            for my $j ( $i + 1 .. -1 + scalar @output ) {
+                my $y = $output[$j];
+                my $d = $x + $y;
+                if ( $c == $d ) {
+                    $output{$c}++;
+                }
+            }
+        }
+    }
+
+    # "Remember the impossible scenario we never planned for?"
+    return [];
+}