Solutions to pwc 113

3 files changed, 71 insertions, 0 deletions

diff --git a/challenge-113/wlmb/blog.txt b/challenge-113/wlmb/blog.txt
new file mode 100644
index 0000000000..3fc9997009
--- /dev/null
+++ b/challenge-113/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2021/05/22/PWC113/
diff --git a/challenge-113/wlmb/perl/ch-1.pl b/challenge-113/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..ee570a3e52
--- /dev/null
+++ b/challenge-113/wlmb/perl/ch-1.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 113
+# Task 1: Represent integer.
+#
+# See https://wlmb.github.io/2021/05/22/PWC113/#task-1-represent-integer
+use strict;
+use warnings;
+use v5.12;
+use List::Util qw(sum0);
+use POSIX qw(floor);
+
+my ($N, $D)=@ARGV; #get arguments from command line.
+    die "Usage: ./ch-1.pl positive-integer digit"
+    unless defined $N and defined $D and $N>=0 and $D=~m/^\d$/ and $N==floor $N;
+my $next=subsets(grep {m/$D/} (1..$N));
+while(my @subset=$next->()){
+    say("Inputs: N=$N D=$D: Output: 1 as $N=", join "+", @subset), exit
+	if sum0(@subset)==$N;
+}
+say "Inputs: N=$N D=$D: Output: 0";
+
+sub subsets {
+    my @set=@_;
+    my $subset_counter=2**@set; # Total number of subsets
+    my $done=0;
+    sub {
+	return () if $done;
+	--$subset_counter;
+	$done=1, return () unless $subset_counter;
+	my @subset=grep {defined $_} map {$subset_counter&(1<<$_)?$set[$_]:undef} 0..@set-1;
+	return @subset;
+    }
+}
diff --git a/challenge-113/wlmb/perl/ch-2.pl b/challenge-113/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..1c5cfba7fb
--- /dev/null
+++ b/challenge-113/wlmb/perl/ch-2.pl
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 113
+# Task 2: Recreate binary tree.
+#
+# See https://wlmb.github.io/2021/05/22/PWC113/#task-2-recreate-binary-tree
+use strict;
+use warnings;
+use v5.12;
+use List::Util qw(sum0);
+
+while(my $tree_string=shift @ARGV){
+    say "Input:  $tree_string";
+    die "Suspicious tree $tree_string" unless $tree_string=~m{^[][,\-+\d\.\se]*$};
+    my $tree=eval $tree_string;
+    die "Bad expression: @!" if @!;
+    say "Output: ", stringify_tree(subtract_tree($tree, sum_tree($tree)));
+}
+
+sub sum_tree { #sum and do some rough validation
+    my $node=shift;
+    die "Wrong format" unless ref($node) eq "ARRAY";
+    return 0 if @$node==0;
+    return $node->[0]+sum0 map {sum_tree($node->[$_])} (1,2) if @$node==3;
+    die "Wrong format";
+}
+
+sub subtract_tree {
+    my ($node, $from)=@_;
+    return [] if @$node==0;
+    return [$from-$node->[0], map {subtract_tree($node->[$_], $from)} (1,2)];
+}
+
+sub stringify_tree {
+    my $node=shift;
+    return "[]" if @$node==0;
+    return sprintf("[%s,%s,%s]", $node->[0], map {stringify_tree($node->[$_])} (1,2));
+}