Solve PWC172

3 files changed, 46 insertions, 0 deletions

diff --git a/challenge-172/wlmb/blog.txt b/challenge-172/wlmb/blog.txt
new file mode 100644
index 0000000000..7aef09841c
--- /dev/null
+++ b/challenge-172/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2022/07/04/PWC172/
diff --git a/challenge-172/wlmb/perl/ch-1.pl b/challenge-172/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..748d5fff51
--- /dev/null
+++ b/challenge-172/wlmb/perl/ch-1.pl
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 172
+# Task 1: Prime partition
+#
+# See https://wlmb.github.io/2022/07/04/PWC172/#task-1-prime-partition
+use v5.36;
+use Math::Prime::Util qw(primes);
+say("Usage: ./ch-1.pl M N\nto find the N-term prime partitions of M\n"), exit
+    unless @ARGV==2;
+my ($m,$n)=@ARGV;
+my @primes=@{primes($m)};
+my @result= partitions($m,$n,\@primes);
+say "$m=", join "+", @$_ foreach @result;
+sub partitions($m, $n, $set){
+    # return all partitions of $m into $n elements of the ordered $set
+    return $m==0?([]):() if $n==0; # () means failure, ([]) means we are done
+    my @set=grep {$_<=$m} @$set; # remove high unneeded elements
+    my @results=();
+    while(@set){
+        my $element=pop @set; # try highest elements first
+        my @r=partitions($m-$element, $n-1, \@set);
+        push @results, map {push @$_, $element; $_} @r if @r;
+    }
+    return @results;
+}
diff --git a/challenge-172/wlmb/perl/ch-2.pl b/challenge-172/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..dec20342f1
--- /dev/null
+++ b/challenge-172/wlmb/perl/ch-2.pl
@@ -0,0 +1,20 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 172
+# Task 2: Prime partition
+#
+# See https://wlmb.github.io/2022/07/04/PWC172/#task-1-five-number-summary
+use v5.36;
+say("Usage: ./ch-2.pl N1 N2...Nk\nto find the five-number summary of the sequence N1...Nk"), exit
+    unless @ARGV;
+say("The sequence should have at least 2 elements"), exit unless @ARGV>=2;
+my @data=sort {$a<=>$b} @ARGV;
+my ($min, $max)=($data[0], $data[-1]);
+my $median=median(@data);
+my $q1=median(@data[0..(@data-2)/2]);
+my $q3=median(@data[(@data+1)/2..@data-1]);
+say join " ", "The five-number summary of ", @ARGV, "is";
+say "min=$min, Q1=$q1, median=$median, Q3=$q3, max=$max";
+
+sub median(@d){
+    @d%2?$d[(@d-1)/2]:($d[@d/2-1]+$d[@d/2])/2
+}