Merge pull request #5565 from wlmb/challenges

Solve PWC149

4 files changed, 111 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..404d464fe6
--- /dev/null
+++ b/challenge-149/wlmb/perl/ch-2.pl
@@ -0,0 +1,26 @@
+#!/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 POSIX qw(floor);
+my @digits=(0..9,'A'..'Z');
+my $largest_base=15; # might overflow above that
+die "Usage: ./ch-2.pl N [P] [Q]... " .
+    "to obtain largest square in base N P Q...\n"
+    unless @ARGV;
+foreach my $base(@ARGV){
+    say("Sorry: $base is too large"), next if $base>$largest_base;
+    my $root=$base**floor($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=floor($N/$base);
+    return reverse map {$digits[$_]} @d;
+}
diff --git a/challenge-149/wlmb/perl/ch-2a.pl b/challenge-149/wlmb/perl/ch-2a.pl
new file mode 100755
index 0000000000..a17736e866
--- /dev/null
+++ b/challenge-149/wlmb/perl/ch-2a.pl
@@ -0,0 +1,63 @@
+#!/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 POSIX qw(floor);
+use Algorithm::Combinatorics qw(combinations permutations);
+use Try::Tiny;
+
+die "Usage: ./ch-2a.pl N [P] [Q]... " .
+    "to obtain largest square in base N P Q...\n"
+    unless @ARGV;
+
+my %map;
+@map{(0..35)}=(0..9, 'A'..'Z');
+my $largest=15;
+
+try {say "f($_)=", largest_square($_)} catch {say $_} foreach(@ARGV);
+
+sub largest_square {
+    my $base=shift;
+    die "Base $base is too large\n" if $base > $largest;
+    my @digits=reverse 0..$base-1;
+    my $result;
+    for my $i(0..$base-1){ # $base-$i is the number of digits to try
+        my $combinations=combinations(\@digits,$base-$i);
+        while(my $c=$combinations->next){
+            my $permutations=permutations($c);
+            my $candidate;
+            while(my $p=$permutations->next){
+                # ignore numbers with leading zeroes
+                # they would appear if when testing shorter candidates
+                next unless $p->[0];
+                my $number=digits_to_number($p, $base);
+                my $sqrt=floor(sqrt($number));
+                $candidate=$number, last if $number==$sqrt*$sqrt;
+                # Found a candidate. The first is the largest so I don't
+                # have to test further permutations
+            }
+            # But I may have to test different combinations
+            $result=$candidate if defined $candidate and (!defined $result or $result<$candidate);
+        }
+        return number_to_digits_base($result, $base) if defined $result;
+        # If I found a candidate for a given length, it is not necessary
+        # to test shorter candidates
+  }
+}
+sub digits_to_number {
+    my ($digits, $base)=@_;
+    my @digits=reverse @$digits;
+    my $power=1;
+    my $result=0;
+    $result+=$_*$power, $power*=$base for(@digits);
+    return $result;
+}
+sub number_to_digits_base {
+    my ($result, $base)=@_;
+    my @result=();
+    do {push @result, $result%$base} while $result=floor $result/=$base;
+    return map {$map{$_}} reverse @result;
+}