Added PDL solutions

3 files changed, 83 insertions, 6 deletions

diff --git a/challenge-147/wlmb/perl/ch-2.pl b/challenge-147/wlmb/perl/ch-2.pl
index 0b28e4bd73..88eecdda76 100755
--- a/challenge-147/wlmb/perl/ch-2.pl
+++ b/challenge-147/wlmb/perl/ch-2.pl
@@ -13,13 +13,13 @@ my $N=shift;
 my $start=time();
 J:
     foreach my $j(2..$N){
-	my $p=$j*(3*$j-1)/2;
-	foreach my $k(1..$j-1){
-	    my $q=$k*(3*$k-1)/2;
-	    say("p$j=$p, p$k=$q, p$j+p$k=", $p+$q, "=p", index_of($p+$q),
-                  " p$j-p$k=", $p-$q, "=p", index_of($p-$q)),
+        my $p=$j*(3*$j-1)/2;
+        foreach my $k(1..$j-1){
+            my $q=$k*(3*$k-1)/2;
+            say("p$j=$p\np$k=$q\np$j-p$k=", $p-$q, "=p", index_of($p-$q),
+                  "\np$j+p$k=", $p+$q, "=p", index_of($p+$q)),
                 last J if pentagonal($q+$p) && pentagonal($p-$q);
-	}
+        }
 }
 say "Time: ", time()-$start;
 sub pentagonal {
diff --git a/challenge-147/wlmb/perl/ch-2a.pl b/challenge-147/wlmb/perl/ch-2a.pl
new file mode 100755
index 0000000000..038b9630d3
--- /dev/null
+++ b/challenge-147/wlmb/perl/ch-2a.pl
@@ -0,0 +1,41 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 147
+# Task 2: pentagon numbers
+#
+# See https://wlmb.github.io/2022/01/10/PWC147/#task-2-pentagon-numbers
+use v5.12;
+use warnings;
+use Time::HiRes qw(time);
+use PDL;
+use PDL::NiceSlice;
+
+die "Usage: ./ch-2a.pl largest_index\n" unless @ARGV==1;
+my $N=shift;
+my $start=time();
+my $n=zeroes(long, $N)->xvals+1;
+my $p=$n*(3*$n-1)/2;
+my $check=pentagonal($p);
+for my $i (2..$p->nelem){
+    my $pi=$p(($i-1));
+    my $pass=which(pentagonal($pi+$p) & pentagonal($pi-$p));
+    next unless $pass->nelem;
+    my $j=$pass((0))+1;
+    my $pj=$p(($j-1));
+    my $s=$pi+$pj;
+    my $d=$pi-$pj;
+    my ($k, $l)=map {index_of($_)} ($d, $s);
+    say "p$i=$pi\np$j=$pj\np$i-p$j=$d=p$k\np$i+p$j=$s=p$l";
+    last;
+}
+say "Time: ", time()-$start;
+sub pentagonal {
+    my $p=shift;
+    my $p241=24*$p+1;
+    my $sp241=$p241->sqrt;
+    return (($p>0)&($sp241**2==$p241) & ($sp241%6==5));
+}
+sub index_of {
+    my $p=24*shift()+1;
+    my $s=sqrt($p);
+    return ($s+1)/6;
+}
diff --git a/challenge-147/wlmb/perl/ch-2b.pl b/challenge-147/wlmb/perl/ch-2b.pl
new file mode 100755
index 0000000000..2011132ecd
--- /dev/null
+++ b/challenge-147/wlmb/perl/ch-2b.pl
@@ -0,0 +1,36 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 147
+# Task 2: pentagon numbers
+#
+# See https://wlmb.github.io/2022/01/10/PWC147/#task-2-pentagon-numbers
+use v5.12;
+use warnings;
+use Time::HiRes qw(time);
+use PDL;
+use PDL::NiceSlice;
+
+die "Usage: ./ch-2a.pl largest_index\n" unless @ARGV==1;
+my $N=shift;
+my $start=time();
+my $n=zeroes(long, $N)->xvals+1;
+my $p=$n*(3*$n-1)/2;
+my $check=pentagonal($p);
+my $pass=whichND(pentagonal($p+$p(*1)) & pentagonal($p-$p(*1)));
+die "Bad luck" unless $pass->dim(1)>0;
+my $ij=$pass(:,(0))+1;
+my ($pi, $pj)=map {$p(($_-1))} (my ($i, $j)=map {$ij(($_))} (0,1));
+my ($s, $d)=($pi+$pj, $pi-$pj);
+my ($k, $l)=map {index_of($_)} ($d, $s);
+say "p$i=$pi\np$j=$pj\np$i-p$j=$d=p$k\np$i+p$j=$s=p$l";
+say "Time: ", time()-$start;
+sub pentagonal {
+    my $p=shift;
+    my $p241=24*$p+1;
+    my $sp241=$p241->sqrt;
+    return (($p>0)&($sp241**2==$p241) & ($sp241%6==5));
+}
+sub index_of {
+    my $p=24*shift()+1;
+    my $s=sqrt($p);
+    return ($s+1)/6;
+}