Truncatable primes
A truncatable prime is prime number that when you successively remove digits from one end of the prime, you are left with a new prime number; for example, the number 997 is called a left-truncatable prime as the numbers 997, 97, and 7 are all prime. The number 7393 is a right-truncatable prime as the numbers 7393, 739, 73, and 7 formed by removing digits from its right are also prime. No zeroes are allowed in truncatable primes.
You are encouraged to solve this task according to the task description, using any language you may know.
The task is to find the largest left-truncatable and right-truncatable primes less than one million.
C.f: Sieve of Eratosthenes; Truncatable Prime from Mathworld.
Ada
<lang Ada> with Ada.Text_IO; use Ada.Text_IO; with Ada.Containers.Ordered_Sets;
procedure Truncatable_Primes is
package Natural_Set is new Ada.Containers.Ordered_Sets (Natural); use Natural_Set;
Primes : Set; function Is_Prime (N : Natural) return Boolean is Position : Cursor := First (Primes); begin while Has_Element (Position) loop if N mod Element (Position) = 0 then return False; end if; Position := Next (Position); end loop; return True; end Is_Prime;
function Is_Left_Trucatable_Prime (N : Positive) return Boolean is M : Natural := 1; begin while Contains (Primes, N mod (M * 10)) and (N / M) mod 10 > 0 loop M := M * 10; if N <= M then return True; end if; end loop; return False; end Is_Left_Trucatable_Prime;
function Is_Right_Trucatable_Prime (N : Positive) return Boolean is M : Natural := N; begin while Contains (Primes, M) and M mod 10 > 0 loop M := M / 10; if M <= 1 then return True; end if; end loop; return False; end Is_Right_Trucatable_Prime;
Position : Cursor;
begin
for N in 2..1_000_000 loop if Is_Prime (N) then Insert (Primes, N); end if; end loop; Position := Last (Primes); while Has_Element (Position) loop if Is_Left_Trucatable_Prime (Element (Position)) then Put_Line ("Largest LTP from 1..1000000:" & Integer'Image (Element (Position))); exit; end if; Previous (Position); end loop; Position := Last (Primes); while Has_Element (Position) loop if Is_Right_Trucatable_Prime (Element (Position)) then Put_Line ("Largest RTP from 1..1000000:" & Integer'Image (Element (Position))); exit; end if; Previous (Position); end loop;
end Truncatable_Primes; </lang> Sample output:
Largest LTP from 1..1000000: 998443 Largest RTP from 1..1000000: 739399
D
<lang d>import std.stdio, std.math, std.string, std.conv;
bool isPrime(int n) {
if (n <= 1) return false; foreach (i; 2 .. cast(int)sqrt(cast(real)n) + 1) if (!(n % i)) return false; return true;
}
bool isLeftTruncatablePrime(int n) {
string s = to!string(n); if (indexOf(s, '0') != -1) return false; foreach (i; 0 .. s.length) if (!isPrime(to!int(s[i .. $]))) return false; return true;
}
bool isRightTruncatablePrime(int n) {
string s = to!string(n); if (indexOf(s, '0') != -1) return false; foreach (i; 0 .. s.length) if (!isPrime(to!int(s[0 .. i+1]))) return false; return true;
}
void main() {
enum int n = 1_000_000; foreach_reverse (i; 2 .. n) if (isLeftTruncatablePrime(i)) { writeln("Largest left-truncatable prime in 2 .. ", n, ": ", i); break; } foreach_reverse (i; 2 .. n) if (isRightTruncatablePrime(i)) { writeln("Largest right-truncatable prime in 2 .. ", n, ": ", i); break; }
}</lang> Output:
Largest left-truncatable prime in 2 .. 1000000: 998443 Largest right-truncatable prime in 2 .. 1000000: 739399
Haskell
Using
from HackageDB
<lang haskell>import Data.Numbers.Primes(primes, isPrime) import Data.List import Control.Arrow
primes1e6 = reverse. filter (notElem '0'. show) $ takeWhile(<=1000000) primes
rightT, leftT :: Int -> Bool rightT = all isPrime. takeWhile(>0). drop 1. iterate (`div`10) leftT x = all isPrime. takeWhile(<x).map (x`mod`) $ iterate (*10) 10
main = do
let (ltp, rtp) = (head. filter leftT &&& head. filter rightT) primes1e6 putStrLn $ "Left truncatable " ++ show ltp putStrLn $ "Right truncatable " ++ show rtp</lang>
Output: <lang haskell>*Main> main Left truncatable 998443 Right truncatable 739399</lang>
Interpretation of the J contribution: <lang haskell>digits = [1..9] :: [Integer] smallPrimes = filter isPrime digits pow10 = iterate (*10) 1 mul10 = (pow10!!). length. show righT = (+) . (10 *) lefT = liftM2 (.) (+) ((*) . mul10)
primesTruncatable f = iterate (concatMap (filter isPrime.flip map digits. f)) smallPrimes</lang> Output: <lang haskell>*Main> maximum $ primesTruncatable righT !! 5 739399
- Main> maximum $ primesTruncatable lefT !! 5
998443</lang>
Icon and Unicon
Icon
<lang Icon>procedure main(arglist)
N := 0 < integer(\arglist[1]) | 1000000 # primes to generator 1 to ... (1M or 1st arglist) D := (0 < integer(\arglist[2]) | 10) / 2 # primes to display (10 or 2nd arglist) P := sieve(N) # from sieve task (modified) write("There are ",*P," prime numbers in the range 1 to ",N) if *P <= 2*D then every writes( "Primes: "|!sort(P)||" "|"\n" ) else every writes( "Primes: "|(L := sort(P))[1 to D]||" "|"... "|L[*L-D+1 to *L]||" "|"\n" ) largesttruncateable(P)
end
procedure largesttruncateable(P) #: find the largest left and right trucatable numbers in P local ltp,rtp
every x := sort(P)[*P to 1 by -1] do # largest to smallest if not find('0',x) then { /ltp := islefttrunc(P,x) /rtp := isrighttrunc(P,x) if \ltp & \rtp then break # until both found } write("Largest left truncatable prime = ", ltp) write("Largest right truncatable prime = ", rtp) return
end
procedure isrighttrunc(P,x) #: return integer x if x and all right truncations of x are in P or fails if x = 0 | (member(P,x) & isrighttrunc(P,x / 10)) then return x end
procedure islefttrunc(P,x) #: return integer x if x and all left truncations of x are in P or fails if *x = 0 | ( (x := integer(x)) & member(P,x) & islefttrunc(P,x[2:0]) ) then return x end</lang>
Sample output:
There are 78498 prime numbers in the range 1 to 1000000 Primes: 2 3 5 7 11 ... 999953 999959 999961 999979 999983 Largest left truncatable prime = 998443 Largest right truncatable prime = 739399
Unicon
The Icon solution works in Unicon.
J
Truncatable primes may be constructed by starting with a set of one digit prime numbers and then repeatedly adding a non-zero digit (using the cartesian product of digit sequences) and, at each step, selecting the prime numbers which result.
In other words, given:
<lang j>selPrime=: #~ 1&p: seed=: selPrime digits=: 1+i.9 step=: selPrime@,@:(,&.":/&>)@{@;</lang>
The largest truncatable primes less than a million can be obtained by adding five digits to the prime seeds, then finding the largest value from the result:
<lang j> >./ digits&step^:5 seed NB. left truncatable 998443
>./ step&digits^:5 seed NB. right truncatable
739399</lang>
Perl6
This uses a fairly naive isprime routine. It works but is slow.
<lang perl6> use v6; my %cache;
sub isprime ($test) {
if defined %cache{$test} { %cache{$test} ?? return 1 !! return 0 }; return (%cache{$test} = 0) if $test ~~ any(0,1); if $test <= 25 { return $test ~~ any(2,3,5,7,11,13,17,19,23) ?? (%cache{$test} = 1) !! (%cache{$test} = 0); } my $root = floor($test ** .5); return (%cache{$test} = 0) unless $test % $_ for (2, 3, * + 2 ... * >= $root); return (%cache{$test} = 1);
}
sub trunc_prime ($filter, $limit) {
my $odd = $limit + ($limit % 2 ?? 0 !! 1); loop (my $loop = $odd; $loop -= 2; $loop <= 2 ) { next if $loop ~~ /0/; # No zeros allowed my $this = $loop; while $this.&isprime { $this.=subst($filter, ); return $loop if $this eq ; } }
}
say "Largest Left Truncatable Prime < 1000000: ",trunc_prime(rx/^\d/, 1000000); say "Largest Right Truncatable Prime < 1000000: ",trunc_prime(rx/\d$/, 1000000); </lang> Output:
Largest Left Truncatable Prime < 1000000: 998443 Largest Right Truncatable Prime < 1000000: 796339
PicoLisp
<lang PicoLisp>(load "@lib/rsa.l") # Use the 'prime?' function from RSA package
(de truncatablePrime? (N Fun)
(for (L (chop N) L (Fun L)) (T (= "0" (car L))) (NIL (prime? (format L))) T ) )
(let (Left 1000000 Right 1000000)
(until (truncatablePrime? (dec 'Left) cdr)) (until (truncatablePrime? (dec 'Right) '((L) (cdr (rot L))))) (cons Left Right) )</lang>
Output:
-> (998443 . 739399)
PowerShell
<lang PowerShell>function IsPrime ( [int] $num ) {
$isprime = @{} 2..[math]::sqrt($num) | Where-Object { $isprime[$_] -eq $null } | ForEach-Object { $_ $isprime[$_] = $true for ( $i=$_*$_ ; $i -le $num; $i += $_ ) { $isprime[$i] = $false } } 2..$num | Where-Object { $isprime[$_] -eq $null }
}
function Truncatable ( [int] $num ) {
$declen = [math]::abs($num).ToString().Length $primes = @() $ltprimes = @{} $rtprimes = @{} 1..$declen | ForEach-Object { $ltprimes[$_]=@{}; $rtprimes[$_]=@{} } IsPrime $num | ForEach-Object { $lastltprime = 2 $lastrtprime = 2 } { $curprim = $_ $curdeclen = $curprim.ToString().Length $primes += $curprim if( $curdeclen -eq 1 ) { $ltprimes[1][$curprim] = $true $rtprimes[1][$curprim] = $true $lastltprime = $curprim $lastrtprime = $curprim } else { $curmod = $curprim % [math]::pow(10,$curdeclen - 1) $curdiv = [math]::floor($curprim / 10) if( $ltprimes[$curdeclen - 1][[int]$curmod] ) { $ltprimes[$curdeclen][$curprim] = $true $lastltprime = $curprim } if( $rtprimes[$curdeclen - 1][[int]$curdiv] ) { $rtprimes[$curdeclen][$curprim] = $true $lastrtprime = $curprim } } if( ( $ltprimes[$curdeclen - 2].Keys.count -gt 0 ) -and ( $ltprimes[$curdeclen - 1].Keys.count -gt 0 ) ) { $ltprimes[$curdeclen -2] = @{} } if( ( $rtprimes[$curdeclen - 2].Keys.count -gt 0 ) -and ( $rtprimes[$curdeclen - 1].Keys.count -gt 0 ) ) { $rtprimes[$curdeclen -2] = @{} } } { "Largest Left Truncatable Prime: $lastltprime" "Largest Right Truncatable Prime: $lastrtprime" }
}</lang>
PureBasic
<lang PureBasic>#MaxLim = 999999
Procedure is_Prime(n)
If n<=1 : ProcedureReturn #False ElseIf n<4 : ProcedureReturn #True ElseIf n%2=0: ProcedureReturn #False ElseIf n<9 : ProcedureReturn #True ElseIf n%3=0: ProcedureReturn #False Else Protected r=Round(Sqr(n),#PB_Round_Down) Protected f=5 While f<=r If n%f=0 Or n%(f+2)=0 ProcedureReturn #False EndIf f+6 Wend EndIf ProcedureReturn #True
EndProcedure
Procedure TruncateLeft(n)
Protected s.s=Str(n), l=Len(s)-1 If Not FindString(s,"0",1) While l>0 s=Right(s,l) If Not is_Prime(Val(s)) ProcedureReturn #False EndIf l-1 Wend ProcedureReturn #True EndIf
EndProcedure
Procedure TruncateRight(a)
Repeat a/10 If Not a Break ElseIf Not is_Prime(a) Or a%10=0 ProcedureReturn #False EndIf ForEver ProcedureReturn #True
EndProcedure
i=#MaxLim Repeat
If is_Prime(i) If Not truncateleft And TruncateLeft(i) truncateleft=i EndIf If Not truncateright And TruncateRight(i) truncateright=i EndIf EndIf If truncateleft And truncateright Break Else i-2 EndIf
Until i<=0
x.s="Largest TruncateLeft= "+Str(truncateleft) y.s="Largest TruncateRight= "+Str(truncateright)
MessageRequester("Truncatable primes",x+#CRLF$+y)</lang>
Python
<lang python>maxprime = 1000000
def primes(n):
multiples = set() prime = [] for i in range(2, n+1): if i not in multiples: prime.append(i) multiples.update(set(range(i*i, n+1, i))) return prime
def truncatableprime(n):
'Return a longest left and right truncatable primes below n' primelist = [str(x) for x in primes(n)[::-1]] primeset = set(primelist) for n in primelist: # n = 'abc'; [n[i:] for i in range(len(n))] -> ['abc', 'bc', 'c'] alltruncs = set(n[i:] for i in range(len(n))) if alltruncs.issubset(primeset): truncateleft = int(n) break for n in primelist: # n = 'abc'; [n[:i+1] for i in range(len(n))] -> ['a', 'ab', 'abc'] alltruncs = set([n[:i+1] for i in range(len(n))]) if alltruncs.issubset(primeset): truncateright = int(n) break return truncateleft, truncateright
print(truncatableprime(maxprime))</lang>
Sample Output
(998443, 739399)
Tcl
<lang tcl>package require Tcl 8.5
- Optimized version of the Sieve-of-Eratosthenes task solution
proc sieve n {
set primes [list] if {$n < 2} {return $primes} set nums [dict create] for {set i 2} {$i <= $n} {incr i} { dict set nums $i "" } set next 2 set limit [expr {sqrt($n)}] while {$next <= $limit} { for {set i $next} {$i <= $n} {incr i $next} {dict unset nums $i} lappend primes $next
dict for {next -} $nums break
} return [concat $primes [dict keys $nums]]
}
proc isLeftTruncatable n {
global isPrime while {[string length $n] > 0} {
if {![info exist isPrime($n)]} { return false } set n [string range $n 1 end]
} return true
} proc isRightTruncatable n {
global isPrime while {[string length $n] > 0} {
if {![info exist isPrime($n)]} { return false } set n [string range $n 0 end-1]
} return true
}
- Demo code
set limit 1000000 puts "calculating primes up to $limit" set primes [sieve $limit] puts "search space contains [llength $primes] members" foreach p $primes {
set isPrime($p) "yes"
} set primes [lreverse $primes]
puts "searching for largest left-truncatable prime" foreach p $primes {
if {[isLeftTruncatable $p]} {
puts FOUND:$p break
}
}
puts "searching for largest right-truncatable prime" foreach p $primes {
if {[isRightTruncatable $p]} {
puts FOUND:$p break
}
}</lang> Output:
calculating primes up to 1000000 search space contains 78498 members searching for largest left-truncatable prime FOUND:998443 searching for largest right-truncatable prime FOUND:739399