Solve PWC149

3 files changed, 46 insertions, 0 deletions

diff --git a/challenge-149/wlmb/blog.txt b/challenge-149/wlmb/blog.txt
new file mode 100644
index 0000000000..03b5ecbc25
--- /dev/null
+++ b/challenge-149/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2022/01/24/PWC149/
diff --git a/challenge-149/wlmb/perl/ch-1.pl b/challenge-149/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..4e47423a98
--- /dev/null
+++ b/challenge-149/wlmb/perl/ch-1.pl
@@ -0,0 +1,21 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 148
+# Task 1: fibonacci digit sum
+#
+# See https://wlmb.github.io/2022/01/24/PWC149/#task-1-fibonacci-digit-sum
+use v5.12;
+use warnings;
+use PDL;
+use PDL::NiceSlice;
+die "Usage: ./ch-1.pl N to obtain N numbers with Fibonacci digit sums\n" unless @ARGV;
+my $N=$ARGV[0];
+my $fibs=pdl(0,1); # first Fibonacci numbers
+my @solutions;
+my $try=0; # next number to try
+while(@solutions<$N){
+    my $sum=pdl(split "", $try)->sumover; # sum of digits
+    $fibs=append($fibs, $fibs(-1)+$fibs(-2)) while($sum>$fibs((-1))); # grow $fibs array as needed
+    push @solutions, $try if any($sum-$fibs==0);
+    ++$try;
+};
+say "f($N)=",pdl(@solutions);
diff --git a/challenge-149/wlmb/perl/ch-2.pl b/challenge-149/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..263a6bc4cc
--- /dev/null
+++ b/challenge-149/wlmb/perl/ch-2.pl
@@ -0,0 +1,24 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 148
+# Task 2: largest square
+#
+# See https://wlmb.github.io/2022/01/24/PWC149/#task-2-largest-square
+use v5.12;
+use warnings;
+use List::MoreUtils qw(duplicates);
+use bigint;
+my @digits=(0..9,'A'..'Z');
+die "Usage: ./ch-2.pl N [P] [Q]... " .
+    "to obtain largest square in base N P Q...\n"
+    unless @ARGV;
+foreach my $base(@ARGV){
+    my $root=$base**($base/2);
+    --$root while duplicates(convert($root*$root, $base));
+    say "f($base)=",convert($root*$root, $base);
+}
+sub convert{
+    my ($N, $base)=@_; # convert $N to $base
+    my @d=();
+    do {push @d, $N%$base} while $N/=$base;
+    return reverse map {$digits[$_]} @d;
+}