Add faster solution to T1

3 files changed, 62 insertions, 22 deletions

diff --git a/challenge-113/wlmb/perl/ch-1.pl b/challenge-113/wlmb/perl/ch-1.pl
index ee570a3e52..dd45af20c1 100755
--- a/challenge-113/wlmb/perl/ch-1.pl
+++ b/challenge-113/wlmb/perl/ch-1.pl
@@ -11,23 +11,22 @@ 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";
+    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 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;
+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
index 1c5cfba7fb..c375f112e2 100755
--- a/challenge-113/wlmb/perl/ch-2.pl
+++ b/challenge-113/wlmb/perl/ch-2.pl
@@ -10,28 +10,33 @@ 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]*$};
+    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)));
+    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;
+    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)];
+    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));
+    return sprintf("[%s,%s,%s]", $node->[0],
+           map {stringify_tree($node->[$_])} (1,2));
 }