diff options
| -rw-r--r-- | challenge-211/wlmb/blog.txt | 2 | ||||
| -rwxr-xr-x | challenge-211/wlmb/perl/ch-1.pl | 24 | ||||
| -rwxr-xr-x | challenge-211/wlmb/perl/ch-2.pl | 22 |
3 files changed, 48 insertions, 0 deletions
diff --git a/challenge-211/wlmb/blog.txt b/challenge-211/wlmb/blog.txt new file mode 100644 index 0000000000..5d17477df3 --- /dev/null +++ b/challenge-211/wlmb/blog.txt @@ -0,0 +1,2 @@ +https://wlmb.github.io/2023/04/03/PWC211/ + diff --git a/challenge-211/wlmb/perl/ch-1.pl b/challenge-211/wlmb/perl/ch-1.pl new file mode 100755 index 0000000000..0e2873fda2 --- /dev/null +++ b/challenge-211/wlmb/perl/ch-1.pl @@ -0,0 +1,24 @@ +#!/usr/bin/env perl +# Perl weekly challenge 211 +# Task 1: Toeplitz Matrix +# +# See https://wlmb.github.io/2023/04/03/PWC211/#task-1-toeplitz-matrix +use v5.36; +use List::Util qw(max min uniq); +my @matrix; +my $N=0; # number of rows +while(<>){ # read the matrix, a space separated row at a time + $matrix[$N++]=[split " "]; +} +my $M=@{$matrix[0]}; # Number of columns +@{$matrix[$_]}==$M || die "Not rectangular" for(1..$N-1); +my $largest=max($N,$M); +my $toeplitz=1; # matrix is toeplitz +for my $diagonal(-$M+1..$N-1){ + $toeplitz &&= # unless it is not + 1==uniq + map {$matrix[$diagonal+$_][$_]} + max(0, -$diagonal)..min($M-1,$N-$diagonal-1); +} +say "@{$matrix[$_]}" for 0..$N-1; +say " -> ", $toeplitz?"true":"false"; diff --git a/challenge-211/wlmb/perl/ch-2.pl b/challenge-211/wlmb/perl/ch-2.pl new file mode 100755 index 0000000000..ae25ceea91 --- /dev/null +++ b/challenge-211/wlmb/perl/ch-2.pl @@ -0,0 +1,22 @@ +#!/usr/bin/env perl +# Perl weekly challenge 211 +# Task 2: Split Same Average +# +# See https://wlmb.github.io/2023/04/03/PWC211/#task-2-split-same-average +use v5.36; +use Algorithm::Combinatorics qw(subsets); +use List::Util qw(sum); +die <<~"FIN" unless @ARGV; + Usage: $0 N1 [N2...] + to test if the set N1 N2... may be split into two proper subsets + with the same average + FIN +my $avg=sum(@ARGV)/@ARGV; +my $subsets=subsets(\@ARGV); +$subsets->next; # Throw away the complete set +my $candidate; +while($candidate=$subsets->next){ + next if @$candidate==0; # Throw away the empty set + last if sum(@$candidate)==$avg*@$candidate; # success +} +say("@ARGV -> ", $candidate && @$candidate? "True: @$candidate" : "False") |