From f5f9c8a7c5b5e6e640c6e52579878e0ed5cc97fa Mon Sep 17 00:00:00 2001
From: Dave Jacoby <jacoby.david@gmail.com>
Date: Mon, 10 Jan 2022 19:44:04 -0500
Subject: 147 - 3 * 7 * 7

---
 challenge-147/dave-jacoby/perl/ch-1.pl | 35 ++++++++++++++++++++++++++++++++
 challenge-147/dave-jacoby/perl/ch-2.pl | 37 ++++++++++++++++++++++++++++++++++
 2 files changed, 72 insertions(+)
 create mode 100644 challenge-147/dave-jacoby/perl/ch-1.pl
 create mode 100644 challenge-147/dave-jacoby/perl/ch-2.pl

(limited to 'challenge-147')

diff --git a/challenge-147/dave-jacoby/perl/ch-1.pl b/challenge-147/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..edc998ee77
--- /dev/null
+++ b/challenge-147/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say postderef signatures state };
+no warnings qw{ experimental };
+
+my %primes;
+my %trunc;
+my $c = 1;
+my $n = 2;
+
+while (1) {
+    if ( is_prime($n) ) {
+        $primes{$n}++;
+        my $copy = $n;
+        while ( length $copy > 0 ) {
+            last unless $primes{$copy};
+            substr( $copy, 0, 1 ) = '';
+            if ( $copy eq '' ) {
+                $trunc{$n}++ if $copy eq '';
+                last;
+            }
+        }
+        last if scalar keys %trunc > 20;
+    }
+    $n++;
+}
+
+say join ', ', sort { $a <=> $b } keys %trunc;
+
+sub is_prime ($n) {
+    for ( 2 .. sqrt $n ) { return unless $n % $_ }
+    return 1;
+}
diff --git a/challenge-147/dave-jacoby/perl/ch-2.pl b/challenge-147/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..4385f57450
--- /dev/null
+++ b/challenge-147/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say postderef signatures state };
+no warnings qw{ experimental };
+
+my $top      = 100_000;
+my @pentagon = map { pentagon($_) } 0 .. $top;
+my %pentagon = map { $_ => 1 } @pentagon;
+
+for my $i ( 1 .. $top ) {
+    for my $j ( 1 .. $i - 1 ) {
+        my $pi  = $pentagon[$i];
+        my $pj  = $pentagon[$j];
+        my $sum = $pi + $pj;
+
+        if ( $pentagon{$sum} ) {
+            my $product = abs( $pi - $pj );
+            if ( $pentagon{$product} ) {
+                say <<"END";
+        P($i) = $pi
+        P($j) = $pj
+        $pi + $pj = $sum
+        abs( $pi - $pj ) = $product
+END
+                exit;
+
+            }
+        }
+
+    }
+}
+
+sub pentagon ( $n ) {
+    return $n * ( ( $n * 3 ) - 1 ) / 2;
+}
-- 
cgit 


From 8c0cebcca5ce2dd8afc24d0e27c8b7ac9a22cced Mon Sep 17 00:00:00 2001
From: Roger Bell_West <Firedrake@users.noreply.github.com>
Date: Tue, 11 Jan 2022 10:19:00 +0000
Subject: Blog post for challenge #147

---
 challenge-147/roger-bell-west/blog.txt | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 challenge-147/roger-bell-west/blog.txt

(limited to 'challenge-147')

diff --git a/challenge-147/roger-bell-west/blog.txt b/challenge-147/roger-bell-west/blog.txt
new file mode 100644
index 0000000000..bd7837be26
--- /dev/null
+++ b/challenge-147/roger-bell-west/blog.txt
@@ -0,0 +1 @@
+https://blog.firedrake.org/archive/2022/01/The_Weekly_Challenge_147__Truncating_the_Pentagon.html
-- 
cgit 


From 8104636ea7da9a4af9712be25c3a4220b41059a3 Mon Sep 17 00:00:00 2001
From: Luca Ferrari <fluca1978@gmail.com>
Date: Tue, 11 Jan 2022 12:13:01 +0100
Subject: Add CTE only solution to task 2 in PostgreSQL.

---
 challenge-147/luca-ferrari/postgresql/ch-2b.sql | 46 +++++++++++++++++++++++++
 1 file changed, 46 insertions(+)
 create mode 100644 challenge-147/luca-ferrari/postgresql/ch-2b.sql

(limited to 'challenge-147')

diff --git a/challenge-147/luca-ferrari/postgresql/ch-2b.sql b/challenge-147/luca-ferrari/postgresql/ch-2b.sql
new file mode 100644
index 0000000000..427419b900
--- /dev/null
+++ b/challenge-147/luca-ferrari/postgresql/ch-2b.sql
@@ -0,0 +1,46 @@
+CREATE OR REPLACE FUNCTION
+f_pentagon( n bigint )
+RETURNS bigint
+AS
+$CODE$
+        SELECT ( n * ( 3 * n - 1 ) / 2 );
+$CODE$
+LANGUAGE sql
+IMMUTABLE;
+
+/*
+pentagon_pairs
+----------------
+1020, 2167
+2167, 1020
+(2 rows)
+
+Time: 5820,066 ms (00:05,820)
+
+*/
+WITH RECURSIVE pentagons( n, p )
+AS
+(
+        SELECT 1 AS n
+               , f_pentagon( 1 ) AS p
+
+UNION
+        SELECT p.n + 1
+               , f_pentagon( p.n + 1 )
+        FROM pentagons p
+        WHERE p.n < 5000
+)
+
+SELECT format( '%s, %s', l.n, r.n ) AS pentagon_pairs
+FROM pentagons l, pentagons r
+WHERE EXISTS(
+      SELECT *
+      FROM pentagons ps
+      WHERE ps.p = l.p + r.p
+      )
+AND EXISTS (
+    SELECT *
+    FROM pentagons ps
+    WHERE ps.p = abs( l.p - r.p )
+    )
+;
-- 
cgit 


From 9a3d08acd419eea6d8401b10ed36e4e0eb2a30c5 Mon Sep 17 00:00:00 2001
From: Luca Ferrari <fluca1978@gmail.com>
Date: Tue, 11 Jan 2022 12:18:33 +0100
Subject: Blog references

---
 challenge-147/luca-ferrari/blog-5.txt | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 challenge-147/luca-ferrari/blog-5.txt

(limited to 'challenge-147')

diff --git a/challenge-147/luca-ferrari/blog-5.txt b/challenge-147/luca-ferrari/blog-5.txt
new file mode 100644
index 0000000000..995a2dacfa
--- /dev/null
+++ b/challenge-147/luca-ferrari/blog-5.txt
@@ -0,0 +1 @@
+https://fluca1978.github.io/2022/01/04/PerlWeeklyChallenge146.html#task2pgb
-- 
cgit 


From da4e84601b870f1c4e3d27e0914fe30245da8222 Mon Sep 17 00:00:00 2001
From: Luca Ferrari <fluca1978@gmail.com>
Date: Tue, 11 Jan 2022 12:47:54 +0100
Subject: Fix error in PostgreSQL solution

---
 challenge-147/luca-ferrari/postgresql/ch-2.sql | 2 --
 1 file changed, 2 deletions(-)

(limited to 'challenge-147')

diff --git a/challenge-147/luca-ferrari/postgresql/ch-2.sql b/challenge-147/luca-ferrari/postgresql/ch-2.sql
index 61465a21c6..67ed7cdeb3 100644
--- a/challenge-147/luca-ferrari/postgresql/ch-2.sql
+++ b/challenge-147/luca-ferrari/postgresql/ch-2.sql
@@ -66,8 +66,6 @@ BEGIN
            IF FOUND THEN
               SELECT current_tuple.n
                      , other_tuple.n
-                     , current_tuple.p
-                     , other_tuple.p
                      , current_tuple.p + other_tuple.p
                      , abs( current_tuple.p - other_tuple.p )
                      , p1.n
-- 
cgit 


From 790f6e7216c1f6d6ed4f79fd34d87e76db8ec022 Mon Sep 17 00:00:00 2001
From: Luca Ferrari <fluca1978@gmail.com>
Date: Tue, 11 Jan 2022 13:35:10 +0100
Subject: Fix blog references.

Thanks @manwar
---
 challenge-147/luca-ferrari/blog-1.txt | 2 +-
 challenge-147/luca-ferrari/blog-2.txt | 2 +-
 challenge-147/luca-ferrari/blog-3.txt | 2 +-
 challenge-147/luca-ferrari/blog-4.txt | 2 +-
 challenge-147/luca-ferrari/blog-5.txt | 2 +-
 5 files changed, 5 insertions(+), 5 deletions(-)

(limited to 'challenge-147')

diff --git a/challenge-147/luca-ferrari/blog-1.txt b/challenge-147/luca-ferrari/blog-1.txt
index af17183edb..f5a4859575 100644
--- a/challenge-147/luca-ferrari/blog-1.txt
+++ b/challenge-147/luca-ferrari/blog-1.txt
@@ -1 +1 @@
-https://fluca1978.github.io/2022/01/04/PerlWeeklyChallenge146.html#task1
+https://fluca1978.github.io/2022/01/10/PerlWeeklyChallenge147.html#task1
diff --git a/challenge-147/luca-ferrari/blog-2.txt b/challenge-147/luca-ferrari/blog-2.txt
index 5e5d379514..c3a26988bb 100644
--- a/challenge-147/luca-ferrari/blog-2.txt
+++ b/challenge-147/luca-ferrari/blog-2.txt
@@ -1 +1 @@
-https://fluca1978.github.io/2022/01/04/PerlWeeklyChallenge146.html#task2
+https://fluca1978.github.io/2022/01/10/PerlWeeklyChallenge147.html#task2
diff --git a/challenge-147/luca-ferrari/blog-3.txt b/challenge-147/luca-ferrari/blog-3.txt
index aa716b41b9..1854457738 100644
--- a/challenge-147/luca-ferrari/blog-3.txt
+++ b/challenge-147/luca-ferrari/blog-3.txt
@@ -1 +1 @@
-https://fluca1978.github.io/2022/01/04/PerlWeeklyChallenge146.html#task1pg
+https://fluca1978.github.io/2022/01/10/PerlWeeklyChallenge146.html#task1pg
diff --git a/challenge-147/luca-ferrari/blog-4.txt b/challenge-147/luca-ferrari/blog-4.txt
index 520b859582..63d8983e4e 100644
--- a/challenge-147/luca-ferrari/blog-4.txt
+++ b/challenge-147/luca-ferrari/blog-4.txt
@@ -1 +1 @@
-https://fluca1978.github.io/2022/01/04/PerlWeeklyChallenge146.html#task2pg
+https://fluca1978.github.io/2022/01/10/PerlWeeklyChallenge147.html#task2pg
diff --git a/challenge-147/luca-ferrari/blog-5.txt b/challenge-147/luca-ferrari/blog-5.txt
index 995a2dacfa..b872164f21 100644
--- a/challenge-147/luca-ferrari/blog-5.txt
+++ b/challenge-147/luca-ferrari/blog-5.txt
@@ -1 +1 @@
-https://fluca1978.github.io/2022/01/04/PerlWeeklyChallenge146.html#task2pgb
+https://fluca1978.github.io/2022/01/10/PerlWeeklyChallenge147.html#task2pgb
-- 
cgit 


From 08a76ad16ee62b2cbb2cda3508445047f2ff9cf1 Mon Sep 17 00:00:00 2001
From: Mohammad S Anwar <mohammad.anwar@yahoo.com>
Date: Tue, 11 Jan 2022 17:56:41 +0000
Subject: - Added guest contributions by Eric Cheung.

---
 .../eric-cheung/excel-vba/Challenge_147.xlsm       | Bin 0 -> 25600 bytes
 challenge-147/eric-cheung/excel-vba/ch-1.bas       |  86 +++++++++++++++++++++
 challenge-147/eric-cheung/python/ch-2.py           |  45 +++++++++++
 3 files changed, 131 insertions(+)
 create mode 100755 challenge-147/eric-cheung/excel-vba/Challenge_147.xlsm
 create mode 100755 challenge-147/eric-cheung/excel-vba/ch-1.bas
 create mode 100755 challenge-147/eric-cheung/python/ch-2.py

(limited to 'challenge-147')

diff --git a/challenge-147/eric-cheung/excel-vba/Challenge_147.xlsm b/challenge-147/eric-cheung/excel-vba/Challenge_147.xlsm
new file mode 100755
index 0000000000..6f7427aff8
Binary files /dev/null and b/challenge-147/eric-cheung/excel-vba/Challenge_147.xlsm differ
diff --git a/challenge-147/eric-cheung/excel-vba/ch-1.bas b/challenge-147/eric-cheung/excel-vba/ch-1.bas
new file mode 100755
index 0000000000..558dd6656c
--- /dev/null
+++ b/challenge-147/eric-cheung/excel-vba/ch-1.bas
@@ -0,0 +1,86 @@
+Attribute VB_Name = "ModTask_01"
+Option Explicit
+
+Public Const strMyTitle As String = "Eric Cheung"
+
+Option Base 1
+Public nPrimeArr() As Long
+Public nPrimeCnt As Integer
+
+Function IsPrime(nInput As Integer) As Boolean
+
+    Dim nNumLoop As Integer
+    
+    If nInput = 1 Then
+        IsPrime = False
+        Exit Function
+    End If
+    
+    For nNumLoop = LBound(nPrimeArr) To UBound(nPrimeArr)
+        If nInput = nPrimeArr(nNumLoop) Then
+            IsPrime = True
+            Exit Function
+        ElseIf nInput Mod nPrimeArr(nNumLoop) = 0 Then
+            IsPrime = False
+            Exit Function
+        End If
+    Next nNumLoop
+
+    IsPrime = True
+    
+End Function
+
+Function IsTruncatablePrime(nInput As Integer) As Boolean
+
+    If nInput = 0 Then
+        IsTruncatablePrime = False
+        Exit Function
+    ElseIf Not IsPrime(nInput) Then
+        IsTruncatablePrime = False
+        Exit Function
+    End If
+    
+    nPrimeCnt = nPrimeCnt + 1
+    ReDim Preserve nPrimeArr(1 To nPrimeCnt)
+    nPrimeArr(nPrimeCnt) = nInput
+    
+    If nInput < 10 Then
+        IsTruncatablePrime = True
+    Else
+        If Val(Mid(CStr(nInput), 2, 1)) = 0 Then
+            IsTruncatablePrime = False
+            Exit Function
+        End If
+        IsTruncatablePrime = IsTruncatablePrime(Val(Right(CStr(nInput), Len(CStr(nInput)) - 1)))
+    End If
+    
+End Function
+
+Sub Task_01()
+
+    Const nTruncatablePrimeCntMax As Integer = 20
+
+    Dim nLoop As Integer, nTruncatablePrimeCnt As Integer
+    Dim strMsg As String
+    
+    ReDim nPrimeArr(1 To 1)
+    
+    nPrimeCnt = 1
+    nPrimeArr(1) = 2
+    nLoop = 3
+    
+    nTruncatablePrimeCnt = 1
+    
+    strMsg = "First " & nTruncatablePrimeCntMax & " left-truncatable prime numbers in base 10 are: " & 2
+
+    Do While (nTruncatablePrimeCnt < nTruncatablePrimeCntMax)
+        If IsTruncatablePrime(nLoop) Then
+            strMsg = strMsg & ", " & nLoop
+            nTruncatablePrimeCnt = nTruncatablePrimeCnt + 1
+        End If
+        nLoop = nLoop + 1
+    Loop
+
+    MsgBox strMsg, vbOKOnly, strMyTitle
+
+End Sub
diff --git a/challenge-147/eric-cheung/python/ch-2.py b/challenge-147/eric-cheung/python/ch-2.py
new file mode 100755
index 0000000000..6a716b2ddd
--- /dev/null
+++ b/challenge-147/eric-cheung/python/ch-2.py
@@ -0,0 +1,45 @@
+## Remarks
+## https://www.mathblog.dk/project-euler-44-smallest-pair-pentagonal-numbers/
+## https://radiusofcircle.blogspot.com/2016/06/problem-44-project-euler-solution-with-python.html
+## http://radiusofcircle.blogspot.com
+
+## Time Module for Calculating Execution Time
+import time
+
+## Time At The Start of Program Execution
+dStartTime = time.time()
+
+def is_pentagonal(nInput):
+    ## Function To Check If The Number is Pentagonal Number or Not
+    if (1 + (24 * nInput + 1) ** 0.5) % 6 == 0:
+        return True
+    return False
+
+## Flag To Check If The Number Is Found Or Not
+bFlag = True
+
+# While Loop Iterator
+nLoop = 1
+
+# While Loop
+while bFlag:
+    nNum_01 = nLoop * (3 * nLoop - 1) / 2
+    for nSubLoop in range(1, nLoop):
+        nNum_02 = nSubLoop * (3 * nSubLoop - 1) / 2
+        if is_pentagonal(nNum_01 + nNum_02) and is_pentagonal(nNum_01 - nNum_02):
+            print ("nLoop = " + str(nLoop) + ", nSubLoop = " + str(nSubLoop))
+            bFlag = False
+            break
+    nLoop = nLoop + 1
+
+# Time At The End of Program Execution
+dEndTime = time.time()
+
+# Printing The Total Time For Execution
+print ("Time Needed: " + str(dEndTime - dStartTime))
+
+
+## Result
+## nLoop = 2167, nSubLoop = 1020
+## Time Needed: 1.1174473762512207
+
-- 
cgit 


From 5e23610010bd9c5dd596e7edcb6748264e94df3f Mon Sep 17 00:00:00 2001
From: Luis Mochan <mochan@fis.unam.mx>
Date: Tue, 11 Jan 2022 15:27:31 -0600
Subject: Solve PWC147

---
 challenge-147/wlmb/blog.txt     |  1 +
 challenge-147/wlmb/perl/ch-1.pl | 41 +++++++++++++++++++++++++++++++++++++++++
 challenge-147/wlmb/perl/ch-2.pl | 34 ++++++++++++++++++++++++++++++++++
 3 files changed, 76 insertions(+)
 create mode 100644 challenge-147/wlmb/blog.txt
 create mode 100755 challenge-147/wlmb/perl/ch-1.pl
 create mode 100755 challenge-147/wlmb/perl/ch-2.pl

(limited to 'challenge-147')

diff --git a/challenge-147/wlmb/blog.txt b/challenge-147/wlmb/blog.txt
new file mode 100644
index 0000000000..0b7e8f9768
--- /dev/null
+++ b/challenge-147/wlmb/blog.txt
@@ -0,0 +1 @@
+https://wlmb.github.io/2022/01/10/PWC147/
diff --git a/challenge-147/wlmb/perl/ch-1.pl b/challenge-147/wlmb/perl/ch-1.pl
new file mode 100755
index 0000000000..1fa2fbebe8
--- /dev/null
+++ b/challenge-147/wlmb/perl/ch-1.pl
@@ -0,0 +1,41 @@
+#!/usr/bin/env perl
+# Perl weekly challenge 147
+# Task 1: Truncatable prime
+#
+# See https://wlmb.github.io/2022/01/10/PWC147/#task-1-truncatable-prime
+use v5.12;
+use warnings;
+use PDL;
+use PDL::NiceSlice;
+use POSIX qw(); # don't import to avoid name collisions with PDL
+use Text::Wrap qw(wrap $columns $break);
+
+die "Usage: ./ch-1.pl size_of_sieve number_of_truncatable_primes [base]\n"
+    unless @ARGV>=2;
+my ($size, $wanted, $base)=@ARGV;
+$base//=10; # decimal numbers by default
+$size=$base**POSIX::ceil(log($size)/log($base)); # Force power of base;
+my $sieve=ones($size); #
+$sieve(0:1).=0; # 0 and 1 are not primes
+# find primes with Eratosthenes sieve
+$sieve($_**2:-1:$_).=0 foreach(2..sqrt($size-1));
+# Remove non-truncatable primes
+for(my $n=$base; $n<$size; $n*=$base){
+    # Reshape sieve as rectangle. The first row all log_base(n) digits
+    $sieve->reshape($n,$size/$n);
+    # Remove from the remaining rows those numbers which don't
+    # correspond to a truncatable prime in the first row
+    $sieve &= $sieve(:,0);
+    # From every tenth row remove numbers that would begin in 0 if truncated
+    $sieve(:,10:-1:10).=0 if $sieve->dim(1)>10;
+}
+$sieve->reshape($size); # return to a 1D sieve
+# The desired primes correspond to the surviving ones in the sieve
+my $truncatable_primes=$sieve->xvals->where($sieve);
+my $found=$truncatable_primes->nelem; # truncatable primes actually found
+say("Didn't find enough ($wanted) primes, please increase size of sieve"),
+    $wanted=$found
+    unless $found >= $wanted;
+$columns=62; $break=qr/\s/;
+say wrap("", "    ", "The first $wanted truncatable primes are: ",
+    join ", ", $truncatable_primes(0:$wanted-1)->list);
diff --git a/challenge-147/wlmb/perl/ch-2.pl b/challenge-147/wlmb/perl/ch-2.pl
new file mode 100755
index 0000000000..0b28e4bd73
--- /dev/null
+++ b/challenge-147/wlmb/perl/ch-2.pl
@@ -0,0 +1,34 @@
+#!/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 bigint;
+use Time::HiRes qw(time);
+
+die "Usage: ./ch-2.pl largest_index\n" unless @ARGV==1;
+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)),
+                last J if pentagonal($q+$p) && pentagonal($p-$q);
+	}
+}
+say "Time: ", time()-$start;
+sub pentagonal {
+    my $p=24*shift()+1;
+    my $s=sqrt($p);
+    return $s**2==$p && $s%6==5;
+}
+sub index_of {
+    my $p=24*shift()+1;
+    my $s=sqrt($p);
+    return ($s+1)/6;
+}
-- 
cgit 


From 9268e1cb3a4fcc65fe025e8e6d2780136294c180 Mon Sep 17 00:00:00 2001
From: Alexander Karelas <karjala@cpan.org>
Date: Wed, 12 Jan 2022 00:01:23 +0200
Subject: my solution to 147-2

---
 challenge-147/alexander-karelas/perl/ch2.pl | 30 +++++++++++++++++++++++++++++
 1 file changed, 30 insertions(+)
 create mode 100755 challenge-147/alexander-karelas/perl/ch2.pl

(limited to 'challenge-147')

diff --git a/challenge-147/alexander-karelas/perl/ch2.pl b/challenge-147/alexander-karelas/perl/ch2.pl
new file mode 100755
index 0000000000..b6548da74a
--- /dev/null
+++ b/challenge-147/alexander-karelas/perl/ch2.pl
@@ -0,0 +1,30 @@
+#!/usr/bin/env perl
+
+use v5.32;
+use warnings;
+
+use experimental 'signatures';
+
+my @cache;
+my %cache;
+sub get_nth_pentagon_number ($n) {
+    my $pentagon = $cache[$n];
+    $pentagon //= do {
+        $cache[$n] = $n * (3 * $n - 1) / 2;
+        $cache{ $cache[$n] } = $n;
+    }
+}
+
+for (my $i = 1; ; $i++) {
+    my $ith = get_nth_pentagon_number($i);
+    get_nth_pentagon_number(2 * $i - 1);
+    get_nth_pentagon_number(2 * $i);
+    for (my $j = 1; $j < $i; $j++) {
+        my $jth = get_nth_pentagon_number($j);
+        if (exists $cache{$ith + $jth} and exists $cache{$ith - $jth}) {
+            say "P($i) + P($j) = $ith + $jth = @{[ $ith + $jth ]} = P(", $cache{$ith + $jth}, ")";
+            say "P($i) - P($j) = $ith - $jth = @{[ $ith - $jth ]} = P(", $cache{$ith - $jth}, ")";
+            exit;
+        }
+    }
+}
-- 
cgit 


From ca2a0fbde12f6e80eb035ff7c574ac3d7bcd67bc Mon Sep 17 00:00:00 2001
From: Peter Campbell Smith <pj.campbell.smith@gmail.com>
Date: Tue, 11 Jan 2022 22:25:03 +0000
Subject: My solutions to week 147

---
 challenge-147/peter-campbell-smith/blog.txt     |   1 +
 challenge-147/peter-campbell-smith/perl/ch-1.pl |  70 +++++++++++++
 challenge-147/peter-campbell-smith/perl/ch-2.pl | 128 ++++++++++++++++++++++++
 3 files changed, 199 insertions(+)
 create mode 100644 challenge-147/peter-campbell-smith/blog.txt
 create mode 100755 challenge-147/peter-campbell-smith/perl/ch-1.pl
 create mode 100755 challenge-147/peter-campbell-smith/perl/ch-2.pl

(limited to 'challenge-147')

diff --git a/challenge-147/peter-campbell-smith/blog.txt b/challenge-147/peter-campbell-smith/blog.txt
new file mode 100644
index 0000000000..78e76441f9
--- /dev/null
+++ b/challenge-147/peter-campbell-smith/blog.txt
@@ -0,0 +1 @@
+https://pjcs-pwc.blogspot.com/2022/01/chop-off-their-heads-and-conquer.html
diff --git a/challenge-147/peter-campbell-smith/perl/ch-1.pl b/challenge-147/peter-campbell-smith/perl/ch-1.pl
new file mode 100755
index 0000000000..0a3901fe78
--- /dev/null
+++ b/challenge-147/peter-campbell-smith/perl/ch-1.pl
@@ -0,0 +1,70 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2022-01-10
+# PWC 147 task 1
+
+use v5.28;
+use warnings;
+use strict;
+
+# Write a script to generate first 20 left-truncatable prime numbers in base 10.
+# In number theory, a left-truncatable prime is a prime number which, in a given base, 
+# contains no 0, and if the leading left digit is successively removed, then all 
+# resulting numbers are primes.
+
+# Note that the last digit cannot be 2, 4, 5, 6, 8, 0 as no primes end with those
+# and cannot be 9 as when all the preceding digits are removed, 9 is not prime,
+# so the last digit can only be 1, 3 or 7.
+
+# The definition above speaks of 'all resulting numbers' so I am ruling out
+# single-digit prime numbers as they have no 'resulting numbers' when the
+# leftmost digit is removed.
+
+my ($seeking, $prime_index, $from, $to, $test, $this, @not_a_prime, $string, $count,
+	$start, $factor, $multiple, $secs);
+
+# initialise
+$seeking = 20;   # how many to find
+$count = 0;      # how many found
+
+# find primes in ranges of 1000
+$secs = time;
+for ($from = 1; ; $from += 1000) {
+	$to = $from + 999;
+
+	# loop over all the possible factors, ie primes < sqrt($to)
+	for $factor (2 .. int(sqrt($to))) {
+		next if defined $not_a_prime[$factor];   # already known as not a prime
+		
+		# mark all the multiples of $factor as non-primes (sieve of Eratosthenes)
+		$start = int($from / $factor);           # multiples less than $start have already been done
+		$start = 2 if $start < 2;
+		for ($multiple = $start; $factor * $multiple <= $to; $multiple ++) {
+			$not_a_prime[$factor * $multiple] = 1;
+		}
+	}
+	
+	# now test the primes in this range for left-truncatability
+	TEST: for $test ($from .. $to) {
+		
+		# remove ineligibles - not prime, is a single digit, contains 0 or ends in 9
+		next if (defined $not_a_prime[$test] or $test =~ m|0| or $test =~ m|9$| or $test < 11);
+			
+		# test for left-truncatability and construct string showing proof
+		$this = $test;
+		$string = qq[$this];
+		
+		# remove successive left digits and test the residue for primeness
+		while ($this =~ s|\d(\d+)|$1|) {   
+			next TEST if $not_a_prime[$this];
+			$string .= qq[ > $this];			
+		}
+		
+		# an answer!
+		say $string;
+		if (++ $count >= $seeking) {
+			say '' . (time - $secs) . qq[ seconds\n];
+			exit;
+		}
+	}
+}
diff --git a/challenge-147/peter-campbell-smith/perl/ch-2.pl b/challenge-147/peter-campbell-smith/perl/ch-2.pl
new file mode 100755
index 0000000000..e10b24053a
--- /dev/null
+++ b/challenge-147/peter-campbell-smith/perl/ch-2.pl
@@ -0,0 +1,128 @@
+#!/usr/bin/perl
+
+# Peter Campbell Smith - 2022-01-10
+# PWC 147 task 2
+
+use v5.28;
+use warnings;
+use strict;
+
+# Write a script to find the first pair of Pentagon Numbers whose sum and difference 
+# are also a Pentagon Number. Pentagon numbers can be defined as P(n) = n(3n - 1)/2.
+
+my $seeking = 1;
+# first_method();   # see blog - it works but is slow
+second_method();    # this is better
+
+#---
+
+sub first_method {
+
+	# first method 
+	my ($found, $n, $pentagon, %p, @f, $m, $diff, %queue, $sum, $mm, $nn, $sum2, $start);
+
+	$start = time;
+	$found = 0;
+
+	for ($n = 1; ; $n ++) {
+		
+		# generate pentagon numbers sequentially
+		$pentagon = $n * (3 * $n - 1) / 2;
+		$p{$pentagon} = $n;     # so for any $j <= $n, $j is a pentagon number if $p{$j}
+		$f[$n] = $pentagon;     # and the $jth pentagon number is $f[$j]
+		next if $n == 1;
+		
+		# check the difference between this pentagon number ($n) and all smaller ones ($m)
+		for $m (1 .. $n - 1)	{
+			$diff = $pentagon - $f[$m];
+			next unless $p{$diff};   # difference is not a pentagon number
+			
+			# the difference is pentagonal; the sum will be more than $pentagon so put it in a queue to be checked later
+			$queue{sprintf('%012d', $f[$m] + $pentagon)} = [$m, $n];   # zero padded key so they sort numerically
+			
+			# test per wikipedia
+			$sum = $f[$m] + $pentagon;
+		}
+		
+		# is $pentagon in the queue of possible answers?
+		for $sum (sort keys %queue) {
+			($mm, $nn) = @{$queue{$sum}};
+			
+			# this queued number is the sum of 2 pentagons which differ by a pentagon, so ... an answer!
+			if ($sum == $pentagon) {   # the queued sum is the pentagon we've just found
+				$diff = $f[$nn] - $f[$mm];
+				$sum2 = $sum + 0;   # get rid of zero padding
+				say qq[First method: ];
+				say qq[Pentagon no $mm is $f[$mm]];
+				say qq[Pentagon no $nn is $f[$nn]];
+				say qq[Their sum is $sum2 which is pentagon number $n];
+				say qq[Their difference is $diff which is pentagon number $p{$diff}];
+				
+				if (++ $found == $seeking) {  # we've achieved the goal
+					say '' . (time - $start) . qq[ seconds\n];
+					return;
+				}
+				delete $queue{$sum};
+				
+			# this queued sum of 2 pentagon numbers is less than the one we just found, 
+			# so it isn't a pentagon number, so take it out of the queue
+			} elsif ($sum < $pentagon) {
+				delete $queue{$sum};
+				
+			# else it's still larger than the pentagon we just found, so leave it in the queue	
+			} else {
+				last;   # and any others are larger still so we con;t need to look at them yet
+			}
+		}
+	}
+}
+
+sub second_method {
+	
+	my ($found, $n, $i, $s, $m, $diff, $sum, %p, @f, $start);
+	
+	$found = 0;
+	$start = time;
+
+	for ($n = 1; ; $n ++) {
+		
+		# find pentagon numbers sequentially 
+		next unless ($i = is_pentagonal($n));   # so $n is the $i'th pentagon
+
+		# so $n is pentagonal
+		$f[$i] = $n;        # and the $i'th pentagon number is $f[$i]
+		$p{$n} = $i;        # if n is a pentagon, it is the $p{$n}'th one
+		next if $n == 1;
+		
+		# check the difference and sum of this pentagon number ($n) and all smaller ones ($m)
+		for $m (1 .. $i - 1)	{
+			$diff = $n - $f[$m]; 
+			$sum = $n + $f[$m];
+			
+			# difference is not a pentagon number
+			next unless $p{$diff};
+			next unless $s = is_pentagonal($sum);   # sum is not a pentagon number
+			
+			# result!
+			say qq[Second method: ];
+			say qq[Pentagon no $i is $n];
+			say qq[Pentagon no $m is $f[$m]];
+			say qq[Their sum is $sum which is pentagon number $s];			
+			say qq[Their difference is $diff which is pentagon number $p{$diff}];
+			if (++ $found == $seeking) {
+				say '' . (time - $start) . qq[ secs\n];
+				return;
+			}
+		}
+	}
+}
+
+sub is_pentagonal {
+	
+	# per Wikipedia
+	
+	my $test = (sqrt(24 * $_[0] + 1) + 1) / 6;
+	my $test1 = $test - int($test + 1e-19);
+	return (abs($test1) <= 1e-19) ? $test : 0;
+}
+
-- 
cgit 


From a4a8fbd0eb824b8a0bd7a50a747238356c46e511 Mon Sep 17 00:00:00 2001
From: Niels van Dijke <perlboy@cpan.org>
Date: Tue, 11 Jan 2022 22:31:09 +0000
Subject: Task 1 & 2

---
 challenge-147/perlboy1967/perl/ch-1.pl | 40 ++++++++++++++++++++++++
 challenge-147/perlboy1967/perl/ch-2.pl | 56 ++++++++++++++++++++++++++++++++++
 2 files changed, 96 insertions(+)
 create mode 100755 challenge-147/perlboy1967/perl/ch-1.pl
 create mode 100755 challenge-147/perlboy1967/perl/ch-2.pl

(limited to 'challenge-147')

diff --git a/challenge-147/perlboy1967/perl/ch-1.pl b/challenge-147/perlboy1967/perl/ch-1.pl
new file mode 100755
index 0000000000..2fbd74581f
--- /dev/null
+++ b/challenge-147/perlboy1967/perl/ch-1.pl
@@ -0,0 +1,40 @@
+#!/bin/perl
+
+=pod
+
+The Weekly Challenge - 147
+ - https://perlweeklychallenge.org/blog/perl-weekly-challenge-147/#TASK1
+
+Author: Niels 'PerlBoy' van Dijke
+
+TASK #1 › Truncatable Prime
+Submitted by: Mohammad S Anwar
+
+Write a script to generate first 20 left-truncatable prime numbers in base 10.
+
+ || In number theory, a left-truncatable prime is a prime number which, in a 
+ || given base, contains no 0, and if the leading left digit is successively 
+ || removed, then all resulting numbers are primes.
+
+=cut
+
+use v5.16;
+
+use Math::Primality qw(next_prime);
+
+my @tPrimes;
+my %primes;
+
+my $n = 1;
+do {
+  $n = next_prime($n);
+  $primes{$n}++;
+
+  if (index($n,0)<0) {
+    my $p = $n;
+    1 while ($p =~ s#^.## && exists $primes{$p});
+    push(@tPrimes,$n) if ($p eq '');
+  }
+} while (scalar @tPrimes < 20);
+
+printf "%s\n", join(',',@tPrimes);
diff --git a/challenge-147/perlboy1967/perl/ch-2.pl b/challenge-147/perlboy1967/perl/ch-2.pl
new file mode 100755
index 0000000000..9a96d111c4
--- /dev/null
+++ b/challenge-147/perlboy1967/perl/ch-2.pl
@@ -0,0 +1,56 @@
+#!/bin/perl
+
+=pod
+
+The Weekly Challenge - 147
+ - https://perlweeklychallenge.org/blog/perl-weekly-challenge-147/#TASK2
+
+Author: Niels 'PerlBoy' van Dijke
+
+TASK #2 › Pentagon Numbers
+Submitted by: Mohammad S Anwar
+
+Write a sript to find the first pair of Pentagon Numbers whose sum and difference
+are also a Pentagon Number.
+
+ || Pentagon numbers can be defined as P(n) = n(3n - 1)/2.
+
+
+=cut
+
+use v5.16;
+
+sub pentagonNumber($) {
+  $_[0]*(3*$_[0]-1) >> 1;
+}
+
+my @p = (undef);
+my %pIdx;
+
+my $i = 1;
+
+while (1) {
+  push(@p,pentagonNumber scalar @p);
+  $pIdx{$p[-1]} = scalar @p - 1;
+
+  foreach my $j (1 .. $i-1) {
+    my $dif = $p[$i] - $p[$j];
+    next if !exists $pIdx{$dif};
+
+    my $sum = $p[$i] + $p[$j];
+
+    while ($p[-1] <= $sum) {
+      push(@p,pentagonNumber scalar @p);
+      $pIdx{$p[-1]} = scalar @p - 1; 
+    }
+
+    if (exists $pIdx{$sum}) {
+      printf "P(%d) + P(%d) = %d + %d = %d = P(%d)\n",
+             $i, $j, $p[$i], $p[$j], $sum, $pIdx{$sum};
+      printf "P(%d) - P(%d) = %d - %d = %d = P(%d)\n",
+             $i, $j, $p[$i], $p[$j], $dif, $pIdx{$dif};
+      exit;
+    } 
+  }
+  $i++;
+}
-- 
cgit 


From 9b1f239ffecd7923ede7ba8d965939fd08fb5661 Mon Sep 17 00:00:00 2001
From: Dave Jacoby <jacoby.david@gmail.com>
Date: Tue, 11 Jan 2022 17:48:03 -0500
Subject: Revise and extend my code, added blog

---
 challenge-147/dave-jacoby/blog.txt     | 1 +
 challenge-147/dave-jacoby/perl/ch-1.pl | 4 ++--
 challenge-147/dave-jacoby/perl/ch-2.pl | 8 +++-----
 3 files changed, 6 insertions(+), 7 deletions(-)
 create mode 100644 challenge-147/dave-jacoby/blog.txt

(limited to 'challenge-147')

diff --git a/challenge-147/dave-jacoby/blog.txt b/challenge-147/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..e386698c3c
--- /dev/null
+++ b/challenge-147/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2022/01/11/truncations-and-pentagons-the-weekly-challenge-147.html
\ No newline at end of file
diff --git a/challenge-147/dave-jacoby/perl/ch-1.pl b/challenge-147/dave-jacoby/perl/ch-1.pl
index edc998ee77..197c72f5b7 100644
--- a/challenge-147/dave-jacoby/perl/ch-1.pl
+++ b/challenge-147/dave-jacoby/perl/ch-1.pl
@@ -11,7 +11,7 @@ my $c = 1;
 my $n = 2;
 
 while (1) {
-    if ( is_prime($n) ) {
+    if ( $n !~ /0/mx && is_prime($n) ) {
         $primes{$n}++;
         my $copy = $n;
         while ( length $copy > 0 ) {
@@ -22,7 +22,7 @@ while (1) {
                 last;
             }
         }
-        last if scalar keys %trunc > 20;
+        last if scalar keys %trunc > 30;
     }
     $n++;
 }
diff --git a/challenge-147/dave-jacoby/perl/ch-2.pl b/challenge-147/dave-jacoby/perl/ch-2.pl
index 4385f57450..61f3b1b1d6 100644
--- a/challenge-147/dave-jacoby/perl/ch-2.pl
+++ b/challenge-147/dave-jacoby/perl/ch-2.pl
@@ -5,16 +5,16 @@ use warnings;
 use feature qw{ say postderef signatures state };
 no warnings qw{ experimental };
 
-my $top      = 100_000;
+my $top      = 10_000;
 my @pentagon = map { pentagon($_) } 0 .. $top;
 my %pentagon = map { $_ => 1 } @pentagon;
+delete $pentagon{0};
 
 for my $i ( 1 .. $top ) {
-    for my $j ( 1 .. $i - 1 ) {
+    for my $j ( 1 .. $i  ) {
         my $pi  = $pentagon[$i];
         my $pj  = $pentagon[$j];
         my $sum = $pi + $pj;
-
         if ( $pentagon{$sum} ) {
             my $product = abs( $pi - $pj );
             if ( $pentagon{$product} ) {
@@ -25,10 +25,8 @@ for my $i ( 1 .. $top ) {
         abs( $pi - $pj ) = $product
 END
                 exit;
-
             }
         }
-
     }
 }
 
-- 
cgit 


From f9f4cfd745b763bdb402c4448f226aa835bc1d3e Mon Sep 17 00:00:00 2001
From: Luis Mochan <mochan@fis.unam.mx>
Date: Tue, 11 Jan 2022 23:29:29 -0600
Subject: Added PDL solutions

---
 challenge-147/wlmb/perl/ch-2.pl  | 12 ++++++------
 challenge-147/wlmb/perl/ch-2a.pl | 41 ++++++++++++++++++++++++++++++++++++++++
 challenge-147/wlmb/perl/ch-2b.pl | 36 +++++++++++++++++++++++++++++++++++
 3 files changed, 83 insertions(+), 6 deletions(-)
 create mode 100755 challenge-147/wlmb/perl/ch-2a.pl
 create mode 100755 challenge-147/wlmb/perl/ch-2b.pl

(limited to 'challenge-147')

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;
+}
-- 
cgit 


From b26ec017a8148667f0b6396fafd64f1ab53b90de Mon Sep 17 00:00:00 2001
From: Luis Mochan <mochan@fis.unam.mx>
Date: Tue, 11 Jan 2022 23:36:41 -0600
Subject: Add more informative message

---
 challenge-147/wlmb/perl/ch-2b.pl | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'challenge-147')

diff --git a/challenge-147/wlmb/perl/ch-2b.pl b/challenge-147/wlmb/perl/ch-2b.pl
index 2011132ecd..c029154bc9 100755
--- a/challenge-147/wlmb/perl/ch-2b.pl
+++ b/challenge-147/wlmb/perl/ch-2b.pl
@@ -16,7 +16,7 @@ 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;
+die "No solution found. Try to increase the largest_index" 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);
-- 
cgit 


From b9ab5ea5e42c2688b4dec80257558e2a8766c2ca Mon Sep 17 00:00:00 2001
From: Mohammad S Anwar <mohammad.anwar@yahoo.com>
Date: Wed, 12 Jan 2022 09:35:37 +0000
Subject: - Added solution by Alexander Karelas.

---
 challenge-147/alexander-karelas/perl/ch-2.pl | 30 ++++++++++++++++++++++++++++
 challenge-147/alexander-karelas/perl/ch2.pl  | 30 ----------------------------
 2 files changed, 30 insertions(+), 30 deletions(-)
 create mode 100755 challenge-147/alexander-karelas/perl/ch-2.pl
 delete mode 100755 challenge-147/alexander-karelas/perl/ch2.pl

(limited to 'challenge-147')

diff --git a/challenge-147/alexander-karelas/perl/ch-2.pl b/challenge-147/alexander-karelas/perl/ch-2.pl
new file mode 100755
index 0000000000..b6548da74a
--- /dev/null
+++ b/challenge-147/alexander-karelas/perl/ch-2.pl
@@ -0,0 +1,30 @@
+#!/usr/bin/env perl
+
+use v5.32;
+use warnings;
+
+use experimental 'signatures';
+
+my @cache;
+my %cache;
+sub get_nth_pentagon_number ($n) {
+    my $pentagon = $cache[$n];
+    $pentagon //= do {
+        $cache[$n] = $n * (3 * $n - 1) / 2;
+        $cache{ $cache[$n] } = $n;
+    }
+}
+
+for (my $i = 1; ; $i++) {
+    my $ith = get_nth_pentagon_number($i);
+    get_nth_pentagon_number(2 * $i - 1);
+    get_nth_pentagon_number(2 * $i);
+    for (my $j = 1; $j < $i; $j++) {
+        my $jth = get_nth_pentagon_number($j);
+        if (exists $cache{$ith + $jth} and exists $cache{$ith - $jth}) {
+            say "P($i) + P($j) = $ith + $jth = @{[ $ith + $jth ]} = P(", $cache{$ith + $jth}, ")";
+            say "P($i) - P($j) = $ith - $jth = @{[ $ith - $jth ]} = P(", $cache{$ith - $jth}, ")";
+            exit;
+        }
+    }
+}
diff --git a/challenge-147/alexander-karelas/perl/ch2.pl b/challenge-147/alexander-karelas/perl/ch2.pl
deleted file mode 100755
index b6548da74a..0000000000
--- a/challenge-147/alexander-karelas/perl/ch2.pl
+++ /dev/null
@@ -1,30 +0,0 @@
-#!/usr/bin/env perl
-
-use v5.32;
-use warnings;
-
-use experimental 'signatures';
-
-my @cache;
-my %cache;
-sub get_nth_pentagon_number ($n) {
-    my $pentagon = $cache[$n];
-    $pentagon //= do {
-        $cache[$n] = $n * (3 * $n - 1) / 2;
-        $cache{ $cache[$n] } = $n;
-    }
-}
-
-for (my $i = 1; ; $i++) {
-    my $ith = get_nth_pentagon_number($i);
-    get_nth_pentagon_number(2 * $i - 1);
-    get_nth_pentagon_number(2 * $i);
-    for (my $j = 1; $j < $i; $j++) {
-        my $jth = get_nth_pentagon_number($j);
-        if (exists $cache{$ith + $jth} and exists $cache{$ith - $jth}) {
-            say "P($i) + P($j) = $ith + $jth = @{[ $ith + $jth ]} = P(", $cache{$ith + $jth}, ")";
-            say "P($i) - P($j) = $ith - $jth = @{[ $ith - $jth ]} = P(", $cache{$ith - $jth}, ")";
-            exit;
-        }
-    }
-}
-- 
cgit 


From eb4ccd1d13b390f36d35102d0630e636caa6e74d Mon Sep 17 00:00:00 2001
From: Mohammad S Anwar <mohammad.anwar@yahoo.com>
Date: Wed, 12 Jan 2022 11:56:55 +0000
Subject: - Added solutions by Ulrich Rieke.

---
 challenge-147/ulrich-rieke/cpp/ch-1.cpp    | 46 ++++++++++++++++++++++++++++++
 challenge-147/ulrich-rieke/haskell/ch-1.hs | 24 ++++++++++++++++
 challenge-147/ulrich-rieke/perl/ch-2.pl    | 42 +++++++++++++++++++++++++++
 challenge-147/ulrich-rieke/raku/ch-1.raku  | 31 ++++++++++++++++++++
 4 files changed, 143 insertions(+)
 create mode 100644 challenge-147/ulrich-rieke/cpp/ch-1.cpp
 create mode 100644 challenge-147/ulrich-rieke/haskell/ch-1.hs
 create mode 100644 challenge-147/ulrich-rieke/perl/ch-2.pl
 create mode 100644 challenge-147/ulrich-rieke/raku/ch-1.raku

(limited to 'challenge-147')

diff --git a/challenge-147/ulrich-rieke/cpp/ch-1.cpp b/challenge-147/ulrich-rieke/cpp/ch-1.cpp
new file mode 100644
index 0000000000..975ba98215
--- /dev/null
+++ b/challenge-147/ulrich-rieke/cpp/ch-1.cpp
@@ -0,0 +1,46 @@
+#include <iostream>
+#include <string>
+#include <cmath>
+#include <vector>
+
+bool isPrime( int n ) {
+  if ( n == 1 )
+      return false ;
+  if ( n == 2 )
+      return true ;
+  int root = static_cast<int>( floor( sqrt( static_cast<double>( n ) ))) ;
+  for ( int i = 2 ; i < root + 1 ; i++ )
+      if ( n % i == 0 )
+    return false ;
+  return true ;
+}
+
+bool isLeftTruncatablePrime( int n ) {
+  if ( ! isPrime( n ) )
+      return false ;
+  std::string numberstring( std::to_string( n ) ) ;
+  auto found = numberstring.find( '0' ) ;
+  if ( found != std::string::npos )
+      return false ;
+  int len = static_cast<int>(numberstring.length( ) ) ;
+  for ( int i = 0 ; i < len ; i++ ) {
+      int num = std::stoi( numberstring.substr( i ) ) ;
+      if ( ! isPrime( num ) )
+    return false ;
+  }
+  return true ;
+}
+
+int main( ) {
+  std::vector<int> leftTruncatables ;
+  int current = 0 ;
+  while ( leftTruncatables.size( ) < 20 ) {
+      current++ ;
+      if ( isLeftTruncatablePrime( current ) )
+    leftTruncatables.push_back( current ) ;
+  }
+  for ( int i : leftTruncatables )
+      std::cout << i << ' ' ;
+  std::cout << std::endl ;
+  return 0 ;
+}
diff --git a/challenge-147/ulrich-rieke/haskell/ch-1.hs b/challenge-147/ulrich-rieke/haskell/ch-1.hs
new file mode 100644
index 0000000000..6c3dec240b
--- /dev/null
+++ b/challenge-147/ulrich-rieke/haskell/ch-1.hs
@@ -0,0 +1,24 @@
+module Challenge147
+  where
+
+isPrime :: Int -> Bool
+isPrime n
+  |n == 1 = False
+  |n == 2 = True
+  |otherwise = null $ filter (\i -> mod n i == 0 ) [2 .. root]
+  where
+      root :: Int
+      root = round $ sqrt $ fromIntegral n
+
+isTruncatablePrime :: Int -> Bool
+isTruncatablePrime n = (not $ elem '0' nstring) && all isPrime theList
+  where
+      l :: Int
+      l = length nstring
+      nstring :: String
+      nstring = show n
+      theList :: [Int]
+      theList = map (\i -> read $ drop i nstring) [0 .. l - 1]
+
+solution :: [Int]
+solution = take 20 $ filter isTruncatablePrime [1 , 2 ..]
diff --git a/challenge-147/ulrich-rieke/perl/ch-2.pl b/challenge-147/ulrich-rieke/perl/ch-2.pl
new file mode 100644
index 0000000000..3267c431cf
--- /dev/null
+++ b/challenge-147/ulrich-rieke/perl/ch-2.pl
@@ -0,0 +1,42 @@
+#!/usr/bin/perl ;
+use strict ;
+use warnings ;
+use Algorithm::Combinatorics qw ( combinations ) ;
+use POSIX ;
+use feature 'say' ;
+
+sub isPentagonNumber {
+  my $num = shift ;
+  my $root = ( sqrt( 24 * $num + 1 ) + 1 ) / 2 ;
+  return floor( $root ) == $root ;
+}
+
+sub toPentagon {
+  my $num = shift ;
+  return ( $num * ( 3 * $num  - 1 )) / 2 ;
+}
+
+my @pentagons = (1, 5, 12, 22, 35, 51, 70, 92, 117 , 145 ) ;
+my $current = 10 ;
+my $iter = combinations( \@pentagons, 2 ) ;
+while ( my $c = $iter->next ) {
+  if ( isPentagonNumber( $c->[ 0 ] + $c->[1] ) &&
+    isPentagonNumber( abs( $c->[0] - $c->[1] ) ) ) {
+      say "$c->[0] , $c->[1]" ;
+      exit( 0 ) ;
+  }
+}
+my $combiFound = 0 ;
+do {
+  $current++ ;
+  push @pentagons , toPentagon( $current ) ;
+  $iter = combinations( \@pentagons , 2 ) ;
+  while ( my $c = $iter->next ) {
+      if ( isPentagonNumber( $c->[ 0 ] + $c->[1] ) &&
+        isPentagonNumber( abs( $c->[0] - $c->[1] ) ) ) {
+    say "$c->[0] , $c->[1]" ;
+    $combiFound = 1 ;
+    last ;
+      }
+  }
+} while ( $combiFound == 0 ) ;
diff --git a/challenge-147/ulrich-rieke/raku/ch-1.raku b/challenge-147/ulrich-rieke/raku/ch-1.raku
new file mode 100644
index 0000000000..d98f9d615e
--- /dev/null
+++ b/challenge-147/ulrich-rieke/raku/ch-1.raku
@@ -0,0 +1,31 @@
+use v6 ;
+
+sub isTruncatablePrime( Int $n is copy --> Bool ) {
+  if ( ~$n ~~ /0/ ) {
+      return False ;
+  }
+  elsif ( not $n.is-prime ) {
+      return False ;
+  }
+  else {
+      while ( $n.is-prime ) {
+    if ( $n < 10 ) {
+        return True ;
+    }
+    else {
+        my $len = ~$n.chars ;
+        $n = $n % ( 10 ** ( $len - 1 ) ) ;
+    }
+      }
+  }
+}
+
+my @truncatables ;
+my $current = 1;
+while ( @truncatables.elems < 20 ) {
+  $current++ ;
+  if ( isTruncatablePrime( $current ) ) {
+      @truncatables.push( $current ) ;
+  }
+}
+say @truncatables ;
-- 
cgit