Solve PWC143

3 files changed, 87 insertions, 0 deletions

diff --git a/challenge-143/wlmb/blog.txt b/challenge-143/wlmb/blog.txt
new file mode 100644
index 0000000000..153d179376
--- /dev/null
+++ b/challenge-143/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2021/12/13/PWC143/
diff --git a/challenge-143/wlmb/perl/ch-1.pl b/challenge-143/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..cc18d4ac91
--- /dev/null
+++ b/challenge-143/wlmb/perl/ch-1.pl
@@ -0,0 +1,63 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 143
+# Task 1: calculator
+#
+# See https://wlmb.github.io/2021/12/13/PWC143/#task-1-calculator
+use v5.12;
+use warnings;
+use Scalar::Util qw(looks_like_number);
+my $original_string;
+my $current;
+my $next;
+foreach (@ARGV){
+    my $original_string=$current=$_;
+    token();
+    my $result=expression();
+    say "$original_string=$result";
+}
+
+sub token {
+    $next=[$1,$1], return if $current=~s{^\s*([()*/+-])}{}; # symbol
+    $next=['N',$1], return
+        if $current=~s{^\s*([^()*/+\-\t\n ]*)}{}
+           and looks_like_number($1); # number?
+    $next=[undef,undef], return if $current=~/^\s*$/; # nothing
+    die "Unrecognizable input: $current";
+}
+
+sub expression {
+    my $result=term();
+    while(1){
+	my $op=$next->[0];
+	last unless defined $op && $op=~m{[+-]};
+	token();
+	$result+=term(),next if $op eq '+';
+	$result-=term(),next if $op eq '-';
+    }
+    return $result;
+}
+
+sub term {
+    my $result=simple();
+    while(1){
+	my $op=$next->[0];
+	last unless defined $op && $op=~m{[*/]};
+	token();
+	$result*=simple(),next if $op eq '*';
+	$result/=simple(),next if $op eq '/';
+    }
+    return $result;
+}
+sub simple {
+    my $op=$next->[0];
+    my $val=$next->[1];
+    die "Unrecognized expression: $current" unless defined $op && $op=~/[-(N]/;
+    token();
+    return -simple() if $op eq '-';
+    return $val if $op eq 'N';
+    my $result=expression();
+    $op=$next->[0];
+    die "Unbalanced parenthesis: $current" unless defined $op and $op eq ')';
+    token();
+    return $result;
+}
diff --git a/challenge-143/wlmb/perl/ch-2.pl b/challenge-143/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..f1deb04daa
--- /dev/null
+++ b/challenge-143/wlmb/perl/ch-2.pl
@@ -0,0 +1,23 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 143
+# Task 1: Stealthy number
+#
+# See https://wlmb.github.io/2021/12/13/PWC143/#task-2-stealthy-number
+use v5.12;
+use warnings;
+use PDL;
+use PDL::NiceSlice;
+foreach my $N(@ARGV){
+    my $Q=sqrt($N); # largest possible small divisor
+    my $s=(sequence($Q)+1);
+    my $d=$s->where($N % $s == 0); # list of divisors<=$Q
+    my $c=$d->cat($d(*)); # cartesian product of divisors
+    my $mask=$d+$N/$d==($d+$N/$d+1)->(*);
+    # Get pairs of divisors that obey the stealthy condition
+    my $d2=$c->whereND(($d+$N/$d)==($d+$N/$d+1)->(*));
+    my $out=$d2->nelem?1:0;
+    say "\nInput: $N Output: ", $out;
+    say "since ", $_((0)),"+",$N/$_((0)),
+        "==",$_((1)),"+",$N/$_((1)),"+1"
+        foreach $d2->transpose->dog;
+}