Add solutions for challenge-144

2 files changed, 82 insertions, 0 deletions

diff --git a/challenge-144/alexander-pankoff/perl/ch-1.pl b/challenge-144/alexander-pankoff/perl/ch-1.pl
new file mode 100755
index 0000000000..700e4beb3b
--- /dev/null
+++ b/challenge-144/alexander-pankoff/perl/ch-1.pl
@@ -0,0 +1,31 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use feature qw'say signatures';
+no warnings qw'experimental::signatures';
+
+use File::Spec;
+use FindBin;
+use List::Util qw(all);
+
+package Challenge143Task02 {
+    require File::Spec->catfile( $FindBin::RealBin,
+        qw'.. .. .. challenge-143 alexander-pankoff perl ch-2.pl' );
+}
+
+run() unless caller();
+
+sub run() {
+    say join( " ", grep { is_semi_prime($_) } 1 .. 100 );
+}
+
+sub is_semi_prime($n) {
+    my @pairs = Challenge143Task02::find_divisors_pairs($n);
+    return @pairs == 2 && all { is_prime($_) } @{ $pairs[1] };
+}
+
+sub is_prime($n) {
+    return $n > 1
+      && Challenge143Task02::find_divisors_pairs($n) == 1;
+}
+
diff --git a/challenge-144/alexander-pankoff/perl/ch-2.pl b/challenge-144/alexander-pankoff/perl/ch-2.pl
new file mode 100755
index 0000000000..34c0bc8674
--- /dev/null
+++ b/challenge-144/alexander-pankoff/perl/ch-2.pl
@@ -0,0 +1,51 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use feature qw'say signatures';
+no warnings qw'experimental::signatures';
+
+use File::Spec;
+use FindBin;
+use List::Util qw(min sum);
+
+use constant DEBUG => $ENV{DEBUG} // 0;
+
+package Challenge141Task02 {
+    require File::Spec->catfile( $FindBin::RealBin,
+        qw'.. .. .. challenge-141 alexander-pankoff perl ch-2.pl' );
+}
+
+run() unless caller();
+
+sub run() {
+    my $u = Challenge141Task02::prompt_for_integer('u');
+
+    my $v;
+    do {
+        $v = Challenge141Task02::prompt_for_integer('v');
+    } while ( $v <= $u && say("'v' must be greater than 'u' ($u)") );
+
+    say join( ', ', generate_ulam_sequence( $u, $v ) );
+}
+
+sub generate_ulam_sequence ( $u, $v, $length = 10 ) {
+    my @sequence = ( $u, $v );
+    my @sums     = ( $u + $v );
+
+    while ( @sequence < $length ) {
+        @sums = grep { $_ > $sequence[-1] } @sums;
+        my @unique_sums = remove_dupes(@sums);
+        my $new         = min(@unique_sums);
+        push @sums, ( map { $_ + $new } @sequence );
+        push @sequence, $new;
+    }
+
+    return @sequence;
+}
+
+sub remove_dupes(@xs) {
+    my %count;
+    $count{$_}++ for @xs;
+    return grep { $count{$_} == 1 } keys %count;
+}
+