Add solutions to PWC133

3 files changed, 61 insertions, 0 deletions

diff --git a/challenge-133/wlmb/blog.txt b/challenge-133/wlmb/blog.txt
new file mode 100644
index 0000000000..50d8eaee77
--- /dev/null
+++ b/challenge-133/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2021/10/06/PWC133/
diff --git a/challenge-133/wlmb/perl/ch-1.pl b/challenge-133/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..6c26b19aa8
--- /dev/null
+++ b/challenge-133/wlmb/perl/ch-1.pl
@@ -0,0 +1,18 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 133
+# Task 1:  integer square root
+#
+# See https://wlmb.github.io/2021/10/06/PWC133/#task-1-integer-square-root
+
+use v5.12;
+use warnings;
+use integer;
+say "√$_=", int_sqrt($_) foreach(@ARGV);
+sub int_sqrt{
+    my $x0=my $N=shift;
+    return "Come on, let's get real" if $N<0;
+    return $N if $x0==0;
+    my $x1=(($N/$x0+$x0)/2); # initial guess
+    ($x0,$x1)=($x1, (($N/$x1+$x1)/2)) while($x1<$x0);
+    return $x0;
+}
diff --git a/challenge-133/wlmb/perl/ch-2.pl b/challenge-133/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..6425250d98
--- /dev/null
+++ b/challenge-133/wlmb/perl/ch-2.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 133
+# Task 2: Smith numbers
+#
+# See https://wlmb.github.io/2021/10/06/PWC133/#task-2-smith-numbers
+use v5.12;
+use warnings;
+use POSIX qw(floor);
+use Math::Prime::Util qw(is_prime factor);
+use List::Util qw(sum0);
+use integer;
+
+my ($desired, $base)=map {floor $_} (@ARGV);
+$desired//=10;
+$base//=10;
+die "Usage: './ch-2.pl desired base' with desired>=0 and base >=2"
+     unless $base>=2 and $desired>0;
+my @smith=();
+my $N=4; # First non-prime
+while(@smith<$desired){
+    push @smith, $N if is_smith($N, $base);
+    ++$N;
+}
+say join " ", "First $desired Smith numbers in base $base:", @smith;
+
+sub is_smith {
+    my ($N, $base)=@_;
+    return 0 if is_prime($N);
+    my $sum_digits=sum0 digits($N, $base);
+    my $sum_factors=sum0 map {digits($_, $base)} factor($N);
+    return $sum_digits==$sum_factors;
+}
+
+sub digits {
+    my ($N,$base)=@_;
+    my @digits;
+    while($N){
+	push @digits, $N%$base;
+	$N/=$base;
+    }
+    @digits;
+}