https://theweeklychallenge.org/blog/perl-weekly-challenge-172/

3 files changed, 138 insertions, 0 deletions

diff --git a/challenge-172/kjetillll/perl/ch-1-faster.pl b/challenge-172/kjetillll/perl/ch-1-faster.pl
new file mode 100644
index 0000000000..d7aead95ff
--- /dev/null
+++ b/challenge-172/kjetillll/perl/ch-1-faster.pl
@@ -0,0 +1,14 @@
+#!/usr/bin/perl
+use strict; use warnings; use v5.10;
+use Math::Prime::Util 'forpart', 'is_prime';
+use List::Util 'any', 'uniq';
+
+my($m, $n) = @ARGV;
+say "@$_" for pp($m, $n);
+
+sub pp {
+    my($m, $n)=@_;
+    my @pp;
+    forpart { any {not is_prime($_)} @_ or @_==&uniq and push @pp,\@_ } $m, {n=>$n};
+    @pp;
+}
diff --git a/challenge-172/kjetillll/perl/ch-1.pl b/challenge-172/kjetillll/perl/ch-1.pl
new file mode 100644
index 0000000000..fc021e854f
--- /dev/null
+++ b/challenge-172/kjetillll/perl/ch-1.pl
@@ -0,0 +1,58 @@
+#!/usr/bin/perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-172/
+
+use strict; use warnings;
+
+my($m, $n) = @ARGV;
+print "@$_\n" for pp($m, $n);
+
+sub pp {  #prime partitions without duplicates, pure perl version
+    my($m, $n, $pp, @p) = @_;
+    $pp //= [];
+    $n ? map pp( $m-$_, $n-1, $pp, @p, $_),
+	 grep is_prime($_),
+	 1+($p[-1]//1) .. $m
+       : $m==0 && push @$pp, \@p;
+    @$pp;
+}
+sub is_prime { local $_ = 1 x (shift//$_); !/^1?$|^(11+?)\1+$/ }
+
+__END__
+
+Example 1:
+
+perl ch-1.pl 73 3   #run with m=73 and n=3 to get the list of the 17
+                    #three part unique prime partitions that adds to 73
+Output:
+
+3 11 59
+3 17 53
+3 23 47
+3 29 41
+5 7 61
+5 31 37
+7 13 53
+7 19 47
+7 23 43
+7 29 37
+11 19 43
+13 17 43
+13 19 41
+13 23 37
+13 29 31
+17 19 37
+19 23 31
+
+Example 2:
+
+perl ch-1.pl 37 4
+2 3 13 19
+2 5 7 23
+2 5 11 19
+2 5 13 17
+2 7 11 17
+
+Example 3, larger numbers:
+
+time perl ch-1.pl 1001 3        | wc -l     # 1061 lines in 34 seconds
+time perl ch-1-faster.pl 1001 3 | wc -l     # 1061 lines in 0.035 seconds, 1000 times faster
diff --git a/challenge-172/kjetillll/perl/ch-2.pl b/challenge-172/kjetillll/perl/ch-2.pl
new file mode 100644
index 0000000000..d6ac326aaf
--- /dev/null
+++ b/challenge-172/kjetillll/perl/ch-2.pl
@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+# https://theweeklychallenge.org/blog/perl-weekly-challenge-172/
+# perl ch-2.pl 13 5 9 7 15            #run with unsorted list of numbers to their five-number summary
+# perl ch-2.pl                        #run without args to run tests
+
+use strict; use warnings; use Carp; use Test::More;
+
+if( @ARGV ){                          #if there are command line arguments
+    my @f = five(@ARGV);
+    my @info = qw(input min q1 median q3 max);
+    printf "%-10s %s\n", shift(@info), $_ for "@ARGV", @f;
+}
+else {
+    do_tests();
+}
+
+
+sub five {                            #method 1 in https://en.wikipedia.org/wiki/Quartile
+    @_==0 and croak "five: got no args";
+    @_==1 and return (@_) x 5;        #same number five times if just one arg
+    my @s    = sort { $a <=> $b } @_; #input sorted
+    my $n    = @s;                    #number of elements
+    my $q1   = int($n/2-1)/2;         #index of q1, can be .5 
+    my $q3   = $n-1-$q1;              #index of q3
+    my $odd  = $n%2;                  #true if n is odd, odd number of elements overall
+    my $oddh = $n%4>1;                #true if the halves have odd number of elements
+    (                                 #return the five numbers:
+     $s[0],                                                 #min
+     $oddh  ?  $s[$q1]  :  ( $s[$q1]    + $s[$q1+1] ) / 2,  #q1, first quartile
+     $odd   ?  $s[$n/2] :  ( $s[$n/2-1] + $s[$n/2]  ) / 2,  #q2, median
+     $oddh  ?  $s[$q3]  :  ( $s[$q3]    + $s[$q3+1] ) / 2,  #q3, third quartile
+     $s[-1]                                                 #max
+    )
+}
+
+sub five_simpler {                        #same simplified, sometimes adds two of same element before / 2
+    my @s = sort { $a <=> $b } @_;
+    my $q1 = int(@s/2-1)/2;
+    my $q3 = @s-1-$q1;
+    (                                     #float indexes use just the integer part
+     $s[0],                               #min
+     ( $s[$q1]      + $s[$q1+.51] ) / 2,  #q1
+     ( $s[@s/2-.49] + $s[@s/2]    ) / 2,  #median
+     ( $s[$q3]      + $s[$q3+.51] ) / 2,  #q3
+     $s[-1]                               #max
+    )
+}
+
+sub do_tests {
+    for my $list (
+      [73                 => [73,73,73,73,73] ],
+      [11,12              => [11,11,11.5,12,12] ],
+      [11,12,13           => [11,11,12,13,13] ],
+      [11,12,13,14        => [11,11.5,12.5,13.5,14] ],
+      [11,12,13,14,15     => [11,11.5,13,14.5,15] ],
+      [11,12,13,14,15,16  => [11,12,13.5,15,16] ],
+      [reverse(11 .. 17)  => [11,12,14,16,17] ],
+    ) {
+	my $expect = pop@$list;
+	is_deeply( $_, $expect, sprintf"%-30s →  %s", "@$list", "@$_" )
+	    for [five(@$list)],
+	        [five_simpler(@$list)];
+    }
+    eval{five()}; ok($@,'no args, got expected croak');
+    done_testing;
+}