Merge pull request #5192 from wlmb/challenges

Solve PWC 138

3 files changed, 62 insertions, 0 deletions

diff --git a/challenge-138/wlmb/blog.txt b/challenge-138/wlmb/blog.txt
new file mode 100644
index 0000000000..4cf8e81a5d
--- /dev/null
+++ b/challenge-138/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2021/11/09/PWC138/
diff --git a/challenge-138/wlmb/perl/ch-1.pl b/challenge-138/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..0e00101a80
--- /dev/null
+++ b/challenge-138/wlmb/perl/ch-1.pl
@@ -0,0 +1,15 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 138
+# Task 1: Workdays
+#
+# See https://wlmb.github.io/2021/11/09/PWC138/#task-1-workdays
+use v5.12;
+use warnings;
+use integer;
+my @workdays=([261, 261, 261, 261, 261, 260, 260],
+              [262, 262, 262, 262, 261, 260, 261]);
+foreach(@ARGV){
+    my $first_weekday=(($_-1)+($_-1)/4-($_-1)/100+($_-1)/400)%7; # 0=Monday
+    my $leap=$_%400==0||$_%4==0&&$_%100!=0;
+    say "Year: $_ Workdays: $workdays[$leap][$first_weekday]"
+}
diff --git a/challenge-138/wlmb/perl/ch-2.pl b/challenge-138/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..2832040d55
--- /dev/null
+++ b/challenge-138/wlmb/perl/ch-2.pl
@@ -0,0 +1,46 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 138
+# Task 2: Split number
+#
+# See https://wlmb.github.io/2021/11/09/PWC138/#task-2-split-number
+use v5.12;
+use warnings;
+use integer;
+use List::Util qw(sum0);
+use POSIX qw(floor);
+foreach(@ARGV){
+    my $sqrt=floor sqrt($_);
+    say("$_ is not a perfect square"),next unless $sqrt**2==$_;
+    my @good_splits=grep {sum0(@$_)==$sqrt} splits($_);
+    say "Input: $_ Output: ",
+        @good_splits
+        ?"1 as ".join("=", (map {join "+", @$_} @good_splits), $sqrt)
+        :0;
+}
+sub splits { # array of all possible ways to split a string
+    my $string=shift;
+    my $counter=0;
+    my @splits=();
+    while(defined (my $split=one_split($string, $counter++))){
+	push @splits, $split;
+    }
+    return @splits;
+}
+sub one_split { # produce the n-th way to split a string
+    my ($string, $counter)=@_;
+    my $length=length $string;
+    return if $counter>=2**($length-1);
+    my @split=();
+    my @binary_counter=split "", sprintf "%0${length}b", $counter;
+    my @chars=split "", $string;
+    my @current=();
+    for(0..$#chars){
+	unshift @current, pop @chars;
+	if(pop @binary_counter){
+	    unshift @split, join '', @current;
+	    @current=();
+	}
+    }
+    unshift @split, join '', @current if @current;
+    return [@split];
+}