diff options
| -rwxr-xr-x | challenge-113/wlmb/perl/ch-1.pl | 33 | ||||
| -rwxr-xr-x | challenge-113/wlmb/perl/ch-1a.pl | 36 | ||||
| -rwxr-xr-x | challenge-113/wlmb/perl/ch-2.pl | 15 |
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)); } |
