Merge pull request #8977 from jacoby/master

DAJ 241

2 files changed, 96 insertions, 0 deletions

diff --git a/challenge-241/dave-jacoby/perl/ch-1.pl b/challenge-241/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..5dc464d0a8
--- /dev/null
+++ b/challenge-241/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+my @examples = (
+
+    { nums => [ 0, 1, 4, 6, 7, 10 ], diff => 3, },
+    { nums => [ 4, 5, 6, 7, 8, 9 ],  diff => 2, }
+);
+
+for my $e (@examples) {
+    my $output = triplets($e);
+    my $nums   = join ', ', map { qq{"$_"} } $e->{nums}->@*;
+    my $diff   = $e->{diff};
+    say <<~"END";
+    Input:  \@nums = ($nums)
+            \$diff = "$diff"
+    Output: $output
+    END
+}
+
+sub triplets ($input) {
+    my $c    = 0;
+    my @nums = $input->{nums}->@*;
+    my $diff = $input->{diff};
+    my $end  = -1 + scalar @nums;
+    for my $i ( 0 .. $end ) {
+        my $ii = $nums[$i];
+        for my $j ( $i + 1 .. $end ) {
+            my $jj = $nums[$j];
+            for my $k ( $j + 1 .. $end ) {
+                my $kk = $nums[$k];
+                next unless $jj - $ii == $diff;
+                next unless $kk - $jj == $diff;
+                $c++;
+            }
+        }
+    }
+    return $c;
+}
diff --git a/challenge-241/dave-jacoby/perl/ch-2.pl b/challenge-241/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..d6f184a780
--- /dev/null
+++ b/challenge-241/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+my @examples = (
+
+    [ 11, 8,  27, 4 ],
+    [ 38, 29, 5,  3 ],
+    [ 12, 4,  18 ],
+    [ 4,  29, 33, 31, 37, 37 ],
+    [ 30, 10, 22, 21 ],
+    [ 30, 36, 29, 1,  15, 19, 10 ],
+    [ 3,  20, 7,  36, 26, 39, 1 ],
+
+);
+for my $e (@examples) {
+    my @output = prime_order( $e->@* );
+    my @input  = $e->@*;
+    my $output = join ', ', @output;
+    my $input  = join ', ', @input;
+    say <<~"END";
+    Input:  \@int = ($input)
+    Output: ($output)
+    END
+}
+
+sub prime_order (@int) {
+    return sort { num_factors($a) <=> num_factors($b) }
+        sort { $a <=> $b } @int;
+}
+
+sub num_factors ($aa) {
+    state $factors;
+    return $factors->{$aa} if defined $factors->{$aa};
+    my $bb = $aa;
+    my @d;
+
+    my $x = 2;
+    my $y = int $aa / 2 + 1;
+    my @factors;
+
+    for my $n ( $x .. $y ) {
+        while ( 0 == $bb % $n ) {
+            $bb = $bb / $n;
+            push @factors, $n;
+        }
+    }
+
+    $factors->{$aa} = scalar @factors;
+    return $factors->{$aa};
+
+}