Merge pull request #4119 from wlmb/challenges

Solutions to pwc 113

4 files changed, 111 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..dd45af20c1
--- /dev/null
+++ b/challenge-113/wlmb/perl/ch-1.pl
@@ -0,0 +1,32 @@
+#!/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 @set=reverse grep {m/$D/} (1..$N); # ordered set from large to small.
+my @answer=find($N,@set);
+say("Inputs: N=$N D=$D: Output: ",
+    @answer? "1 as $N=". join("+", @answer):"0");
+
+
+sub find {
+    my ($goal, @set)=@_;
+    die "Shouldn't happen" if $goal==0;
+    while(defined (my $current=shift @set)){
+	next if $current > $goal;
+	return ($current) if $current==$goal;
+	my @answer=find($goal-$current, @set);
+	return ($current,@answer) if @answer;
+    }
+    return ();
+}
diff --git a/challenge-113/wlmb/perl/ch-1a.pl b/challenge-113/wlmb/perl/ch-1a.pl
new file mode 100755
index 0000000000..7ae51a652c
--- /dev/null
+++ b/challenge-113/wlmb/perl/ch-1a.pl
@@ -0,0 +1,36 @@
+#!/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-1a.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..c375f112e2
--- /dev/null
+++ b/challenge-113/wlmb/perl/ch-2.pl
@@ -0,0 +1,42 @@
+#!/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));
+}