Merge pull request #6419 from jacoby/master

 DAJ 172

2 files changed, 87 insertions, 0 deletions

diff --git a/challenge-172/dave-jacoby/perl/ch-1.pl b/challenge-172/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..6f4bc28a3a
--- /dev/null
+++ b/challenge-172/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,55 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use Getopt::Long;
+
+my $m = 18;
+my $n = 2;
+
+GetOptions(
+    'm=i' => \$m,
+    'n=i' => \$n,
+);
+
+my $done;
+prime_partitions( $m, $n );
+
+exit;
+
+sub prime_partitions ( $m, $n ) {
+    say <<"END";
+M: $m 
+N: $n
+END
+    _prime_partitions( $m, $n );
+    say '';
+}
+
+sub _prime_partitions ( $m, $n, $baggage = [] ) {
+    if ( $n <= 1 ) {
+        if ( is_prime($m) && 0 == grep { /$m/ } $baggage->@* ) {
+            my $bag = join ' ', sort { $a <=> $b } $baggage->@*, $m;
+            return if $done->{$bag}++;
+            say qq{ $bag };
+            return;
+        }
+    }
+    else {
+        for my $i ( 1 .. $m - 1 ) {
+            next if !is_prime($i);
+            next if grep { /$i/ } $baggage->@*;
+            _prime_partitions( $m - $i, $n - 1, [ sort $baggage->@*, $i ] );
+        }
+    }
+}
+
+sub is_prime ($n) {
+    die "Bad number $n" unless length $n;
+    return 0 if $n == 0;
+    return 0 if $n == 1;
+    for ( 2 .. sqrt $n ) { return 0 unless $n % $_ }
+    return 1;
+}
diff --git a/challenge-172/dave-jacoby/perl/ch-2.pl b/challenge-172/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..011d7a8650
--- /dev/null
+++ b/challenge-172/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,32 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ say postderef signatures state };
+
+use List::Util qw{ min max sum0 };
+
+my @array = ( 0, 0, 1, 2, 63, 61, 27, 13 );
+
+my @five = five_number_summary(@array);
+say join ' ', @five;
+
+sub five_number_summary ( @array ) {
+    my $min    = min @array;
+    my $max    = max @array;
+    my $median = median(@array);
+    my $lc     = median( grep { $_ < $median } @array );
+    my $uc     = median( grep { $_ > $median } @array );
+    return $min, $lc, $median, $uc, $max;
+}
+
+sub median ( @array ) {
+    my @sorted = sort { $a <=> $b } @array;
+    while ( scalar @sorted > 2 ) {
+        shift @sorted;
+        pop @sorted;
+    }
+
+    return ( sum0 @sorted ) / 2 if scalar @sorted > 1;
+    return $sorted[0];
+}