Truncatable primes

From Rosetta Code
Task
Truncatable primes
You are encouraged to solve this task according to the task description, using any language you may know.

A truncatable prime is a 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.

The task is to find the largest left-truncatable and right-truncatable primes less than one million (base 10 is implied).

C.f

Category:Prime_Numbers

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

ALGOL 68

Translation of: C

Note: This specimen retains the original C coding style.

Works with: ALGOL 68 version Revision 1 - no extensions to language used.
Works with: ALGOL 68G version Any - tested with release 1.18.0-9h.tiny.

<lang algol68>#!/usr/local/bin/a68g --script #

PROC is prime = (INT n)BOOL:(

 []BOOL is short prime=(FALSE, TRUE, TRUE, FALSE, TRUE, FALSE, TRUE, FALSE, FALSE);
 IF n<=UPB is short prime THEN is short prime[n] # EXIT # ELSE
   IF ( NOT ODD n | TRUE | n MOD 3 = 0 ) THEN FALSE # EXIT # ELSE
     INT h := ENTIER sqrt(n)+3;
     FOR a FROM 7 BY 6 WHILE a<h DO
       IF ( n MOD a = 0 | TRUE |  n MOD (a-2) = 0 ) THEN false exit FI
     OD;
     TRUE # EXIT #
   FI
 FI EXIT
 false exit: FALSE

);

PROC string to int = (STRING in a)INT:(

 FILE f; STRING a := in a; associate(f, a);
 INT i; get(f, i); close(f);
 i

);

PROC is trunc prime = (INT in n, PROC(REF STRING)VOID trunc)BOOL: (

 INT n := in n;
 STRING s := whole(n, 0);
 IF char in string("0", NIL, s) THEN FALSE # EXIT #
 ELSE
   WHILE is prime(n) DO
     s := whole(n, 0);
     trunc(s);
     IF UPB s = 0 THEN true exit FI;
     n := string to int(s)
   OD;
   FALSE EXIT
   true exit: TRUE
 FI

);

PROC get trunc prime = (INT in n, PROC(REF STRING)VOID trunc)VOID:(

 FOR n FROM in n BY -1 TO 1 DO
   IF is trunc prime(n, trunc) THEN
     printf(($g(0)l$, n));
     break
   FI
 OD;
 break: ~

);

main:(

 INT limit = 1000000;
 printf(($g g(0) gl$,"Highest left- and right-truncatable primes under ",limit,":"));
 get trunc prime(limit, (REF STRING s)VOID: s := s[LWB s+1:]);
 get trunc prime(limit, (REF STRING s)VOID: s := s[:UPB s-1]);
 write("Press Enter");
 read(newline)

)</lang> Output:

Highest left- and right-truncatable primes under 1000000:
998443
739399
Press Enter

C

<lang C>#include <stdio.h>

  1. include <stdlib.h>
  2. include <string.h>
  1. define MAX_PRIME 1000000

char *primes; int n_primes;

/* Sieve. If we were to handle 10^9 range, use bit field. Regardless,

*  if a large amount of prime numbers need to be tested, sieve is fast.
*/

void init_primes() { int j; primes = malloc(sizeof(char) * MAX_PRIME); memset(primes, 1, MAX_PRIME); primes[0] = primes[1] = 0; int i = 2; while (i * i < MAX_PRIME) { for (j = i * 2; j < MAX_PRIME; j += i) primes[j] = 0; while (++i < MAX_PRIME && !primes[i]); } }

int left_trunc(int n) { int tens = 1; while (tens < n) tens *= 10;

while (n) { if (!primes[n]) return 0; tens /= 10; if (n < tens) return 0; n %= tens; } return 1; }

int right_trunc(int n) { while (n) { if (!primes[n]) return 0; n /= 10; } return 1; }

int main() { int n; int max_left = 0, max_right = 0; init_primes();

for (n = MAX_PRIME - 1; !max_left; n -= 2) if (left_trunc(n)) max_left = n;

for (n = MAX_PRIME - 1; !max_right; n -= 2) if (right_trunc(n)) max_right = n;

printf("Left: %d; right: %d\n", max_left, max_right); return 0; }</lang>output<lang>Left: 998443; right: 739399</lang>

Faster way of doing primality test for small numbers (1000000 isn't big), and generating truncatable primes bottom-up: <lang c>#include <stdio.h>

  1. define MAXN 1000000

int maxl, maxr;

int is_prime(int n) { int p; if (n % 3 == 0) return 0;

for (p = 6; p * p <= n; p += 6) if (!(n % (p + 1) && n % (p + 5))) return 0; return 1; }

void left(int n, int tens) { int i, nn;

if (n > maxl) maxl = n; if (n < MAXN / 10) for (tens *= 10, i = 1; i < 10; i++) if (is_prime(nn = i * tens + n)) left(nn, tens); }

void right(int n) { int i, nn; static int d[] = {1,3,7,9};

if (n > maxr) maxr = n; if (n < MAXN / 10) for (i = 1; i < 4; i++) if (is_prime(nn = n * 10 + d[i])) right(nn); }

int main(void) { left(3, 1); left(7, 1); right(3); right(5); right(7);

printf("%d %d\n", maxl, maxr);

return 0; }</lang>

Output:
998443 739399

C#

<lang csharp>using System; using System.Diagnostics;

namespace RosettaCode {

 internal class Program
 {
   public static bool IsPrime(int n)
   {
     if (n<2) return false;
     if (n<4) return true;
     if (n%2==0) return false;
     if (n<9) return true;
     if (n%3==0) return false;
     var r = (int) Math.Sqrt(n);
     var f = 6-1;
     while (f<=r)
     {
       if (n%f==0 ||n%(f+2)==0)
         return false;
       f += 6;
     }
     return true;
   }
   private static bool IsRightTruncatable(int n)
   {
     for (;;)
     {
       n /= 10;
       if (n==0)
         return true;
       if (!IsPrime(n))
         return false;
     }
   }
   private static bool IsLeftTruncatable(int n)
   {
     string c = n.ToString();
     if (c.Contains("0"))
       return false;
     for (int i = 1; i<c.Length; i++)
       if (!IsPrime(Convert.ToInt32(c.Substring(i))))
         return false;
     return true;
   }
   private static void Main()
   {
     var sb = new Stopwatch();
     sb.Start();
     int lt = 0, rt = 0;
     for (int i = 1000000; i>0; --i)
     {
       if (IsPrime(i))
       {
         if (rt==0 && IsRightTruncatable(i))
           rt = i;
         else if (lt==0 && IsLeftTruncatable(i))
           lt = i;
         if (lt!=0 && rt!=0)
           break;
       }
     }
     sb.Stop();
     Console.WriteLine("Largest truncable left is={0} & right={1}, calculated in {2} msec.",
                       lt, rt, sb.ElapsedMilliseconds);
   }
 }

}</lang>

Largest truncable left is=998443 & right=739399, calculated in 16 msec.

Clojure

<lang Clojure>(use '[clojure.contrib.lazy-seqs :only [primes]])

(def prime?

 (let [mem (ref #{})

primes (ref primes)]

   (fn [n]
     (dosync
      (if (< n (first @primes))

(@mem n) (let [[mems ss] (split-with #(<= % n) @primes)] (ref-set primes ss) ((commute mem into mems) n)))))))

(defn drop-lefts [n]

 (let [dropl #(if (< % 10) 0 (Integer. (subs (str %) 1)))]
   (->> (iterate dropl n)

(take-while pos? ,) next)))

(defn drop-rights [n]

 (->> (iterate #(quot % 10) n)
      next
      (take-while pos? ,)))

(defn truncatable-left? [n]

 (every? prime? (drop-lefts n)))

(defn truncatable-right? [n]

 (every? prime? (drop-rights n)))

user> (->> (for [p primes :while (< p 1000000) :when (not-any? #{\0} (str p)) :let [l? (if (truncatable-left? p) p 0) r? (if (truncatable-right? p) p 0)] :when (or l? r?)]

      [l? r?])
    ((juxt #(apply max-key first %) #(apply max-key second %)) ,)
    ((juxt ffirst (comp second second)) ,)
    (map vector ["left truncatable: " "right truncatable: "] ,))

(["left truncatable: " 998443] ["right truncatable: " 739399])</lang>

CoffeeScript

<lang coffeescript># You could have symmetric algorithms for max right and left

  1. truncatable numbers, but they lend themselves to slightly
  2. different optimizations.

max_right_truncatable_number = (n, f) ->

 # This algorithm only evaluates 37 numbers for primeness to
 # get the max right truncatable prime < 1000000.  Its
 # optimization is that it prunes candidates for
 # the first n-1 digits before having to iterate through
 # the 10 possibilities for the last digit.
 if n < 10
   candidate = n 
   while candidate > 0
     return candidate if f(candidate)
     candidate -= 1
 else
   left = Math.floor n / 10
   while left > 0
     left = max_right_truncatable_number left, f
     right = 9
     while right > 0
       candidate = left * 10 + right
       return candidate if candidate <= n and f(candidate)
       right -= 1
     left -= 1
 throw Error "none found"
     

max_left_truncatable_number = (max, f) ->

 # This is a pretty straightforward countdown.  The first
 # optimization here would probably be to cache results of 
 # calling f on small numbers.
 is_left_truncatable = (n) ->
   candidate = 0
   power_of_ten = 1
   while n > 0
     r = n  % 10
     return false if r == 0
     n = Math.floor n / 10
     candidate = r * power_of_ten + candidate
     power_of_ten *= 10
     return false unless f(candidate)
   true
 do ->
   n = max
   while n > 0
     return n if is_left_truncatable n, f
     n -= 1
   throw Error "none found"
 

is_prime = (n) ->

 return false if n == 1
 return true if n == 2
 for d in [2..n]
   return false if n % d == 0
   return true if d * d >= n


console.log "right", max_right_truncatable_number(999999, is_prime) console.log "left", max_left_truncatable_number(999999, is_prime) </lang> output <lang> > coffee truncatable_prime.coffee right 739399 left 998443 </lang>

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 isTruncatablePrime(bool left)(int n) {

 string s = to!string(n);
 if (indexOf(s, '0') != -1)
   return false;
 foreach (i; 0 .. s.length)
   static if (left) {
     if (!isPrime(to!int(s[i .. $])))
       return false;
   } else {
     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 (isTruncatablePrime!true(i)) {
     writeln("Largest left-truncatable prime in 2 .. ", n, ": ", i);
     break;
   }
 foreach_reverse (i; 2 .. n)
   if (isTruncatablePrime!false(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

Fortran

Works with: Fortran version 95 and later

<lang fortran>module primes_mod

 implicit none
 
 logical, allocatable :: primes(:)
 

contains

subroutine Genprimes(parr)

 logical, intent(in out) :: parr(:)
 integer :: i

! Prime sieve

 parr = .true.
 parr (1) = .false.
 parr (4 : size(parr) : 2) = .false.
 do i = 3, int (sqrt (real (size(parr)))), 2
   if (parr(i)) parr(i * i : size(parr) : i) = .false.
 end do

end subroutine

function is_rtp(candidate)

 logical :: is_rtp
 integer, intent(in) :: candidate
 integer :: n
 is_rtp = .true.
 n = candidate / 10
 do while(n > 0)
   if(.not. primes(n)) then
     is_rtp = .false.
     return
   end if
   n = n / 10
 end do
 

end function

function is_ltp(candidate)

 logical :: is_ltp
 integer, intent(in) :: candidate
 integer :: i, n
 character(10) :: nstr
 write(nstr, "(i10)") candidate
 is_ltp = .true.
 do i = len_trim(nstr)-1, 1, -1
   n = mod(candidate, 10**i)
   if(.not. primes(n)) then
     is_ltp = .false.
     return
   end if
 end do

end function

end module primes_mod

program Truncatable_Primes

 use primes_mod
 implicit none
 
 integer, parameter :: limit = 999999
 integer :: i
 character(10) :: nstr

! Generate an array of prime flags up to limit of search

 allocate(primes(limit))
 call Genprimes(primes)
  

! Find left truncatable prime

 do i = limit, 1, -1
   write(nstr, "(i10)") i
   if(index(trim(nstr), "0") /= 0) cycle      ! check for 0 in number
   if(is_ltp(i)) then
     write(*, "(a, i0)") "Largest left truncatable prime below 1000000 is ", i
     exit
   end if
 end do

! Find right truncatable prime

 do i = limit, 1, -1
   write(nstr, "(i10)") i
   if(index(trim(nstr), "0") /= 0) cycle      ! check for 0 in number
   if(is_rtp(i)) then
     write(*, "(a, i0)") "Largest right truncatable prime below 1000000 is ", i
     exit
   end if
 end do

end program</lang> Output

Largest left truncatable prime below 1000000 is 998443
Largest right truncatable prime below 1000000 is 739399

Go

<lang go>package main

import "fmt"

func main() {

   sieve(1e6)
   if !search(6, 1e6, "left", func(n, pot int) int { return n % pot }) {
       panic("997?")
   }
   if !search(6, 1e6, "right", func(n, _ int) int { return n / 10 }) {
       panic("7393?")
   }

}

var c []bool

func sieve(ss int) {

   c = make([]bool, ss)
   c[1] = true
   for p := 2; ; {
       p2 := p * p
       if p2 >= ss {
           break
       }
       for i := p2; i < ss; i += p {
           c[i] = true
       }
       for {
           p++
           if !c[p] {
               break
           }
       }
   }

}

func search(digits, pot int, s string, truncFunc func(n, pot int) int) bool {

   n := pot - 1
   pot /= 10

smaller:

   for ; n >= pot; n -= 2 {
       for tn, tp := n, pot; tp > 0; tp /= 10 {
           if tn < tp || c[tn] {
               continue smaller
           }
           tn = truncFunc(tn, tp)
       }
       fmt.Println("max", s, "truncatable:", n)
       return true
   }
   if digits > 1 {
       return search(digits-1, pot, s, truncFunc)
   }
   return false

}</lang> Output:

max left truncatable: 998443
max right truncatable: 739399

Haskell

Using

Library: Primes

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

<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

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>

Java

<lang Java> import java.util.BitSet;

public class Main {

public static void main(String[] args){

final int MAX = 1000000;

//Sieve of Eratosthenes (using BitSet only for odd numbers) BitSet primeList = new BitSet(MAX>>1); primeList.set(0,primeList.size(),true);

int sqroot = (int) Math.sqrt(MAX); primeList.clear(0); for(int num = 3; num <= sqroot; num+=2) { if( primeList.get(num >> 1) ) { int inc = num << 1; for(int factor = num * num; factor < MAX; factor += inc) { //if( ((factor) & 1) == 1) //{ primeList.clear(factor >> 1); //} } } } //Sieve ends...

//Find Largest Truncatable Prime. (so we start from 1000000 - 1 int rightTrunc = -1, leftTrunc = -1; for(int prime = (MAX - 1) | 1; prime >= 3; prime -= 2) { if(primeList.get(prime>>1)) { //Already found Right Truncatable Prime? if(rightTrunc == -1) { int right = prime; while(right > 0 && primeList.get(right >> 1)) right /= 10; if(right == 0) rightTrunc = prime; }

//Already found Left Truncatable Prime? if(leftTrunc == -1 ) { //Left Truncation String left = Integer.toString(prime); if(!left.contains("0")) { while( left.length() > 0 ){ int iLeft = Integer.parseInt(left); if(!primeList.get( iLeft >> 1)) break; left = left.substring(1); } if(left.length() == 0) leftTrunc = prime; } } if(leftTrunc != -1 && rightTrunc != -1) //Found both? then Stop loop { break; } } } System.out.println("Left Truncatable : " + leftTrunc); System.out.println("Right Truncatable : " + rightTrunc); } } </lang> Output :

Left  Truncatable : 998443
Right Truncatable : 796339

Lua

<lang lua>max_number = 1000000

numbers = {} for i = 2, max_number do

   numbers[i] = i;

end

for i = 2, max_number do

   for j = i+1, max_number do
       if numbers[j] ~= 0 and j % i == 0 then numbers[j] = 0 end
   end

end

max_prime_left, max_prime_right = 2, 2 for i = 2, max_number do

   if numbers[i] ~= 0 then 
       local is_prime = true
       
       local l = math.floor( i / 10 )
       while l > 1 do
           if numbers[l] == 0 then
               is_prime = false
               break 
           end
           l = math.floor( l / 10 )
       end
       if is_prime then
           max_prime_left = i
       end
       
       is_prime = true
       local n = 10;
       while math.floor( i % 10 ) ~= 0 and n < max_number do
           if numbers[ math.floor( i % 10 ) ] ~= 0 then
               is_prime = false
               break
           end
           n = n * 10
       end    
       if is_prime then
           max_prime_right = i
       end
   end

end

print( "max_prime_left = ", max_prime_left ) print( "max_prime_right = ", max_prime_right )</lang>

Mathematica

<lang Mathematica>LeftTruncatablePrimeQ[n_] := Times @@ IntegerDigits[n] > 0 &&

 And @@ PrimeQ /@ ToExpression /@ StringJoin /@ 
     Rest[Most[NestList[Rest, #, Length[#]] &[Characters[ToString[n]]]]]

RightTruncatablePrimeQ[n_] := Times @@ IntegerDigits[n] > 0 &&

 And @@ PrimeQ /@ ToExpression /@ StringJoin /@ 
     Rest[Most[NestList[Most, #, Length[#]] &[Characters[ToString[n]]]]]</lang>

Example usage:

n = PrimePi[1000000]; While[Not[LeftTruncatablePrimeQ[Prime[n]]], n--]; Prime[n]
-> 998443

n = PrimePi[1000000]; While[Not[RightTruncatablePrimeQ[Prime[n]]], n--]; Prime[n]
-> 739399

MATLAB

largestTruncatablePrimes.m: <lang MATLAB>function largestTruncatablePrimes(boundary)

   %Helper function for checking if a prime is left of right truncatable
   function [leftTruncatable,rightTruncatable] = isTruncatable(prime,checkLeftTruncatable,checkRightTruncatable)
       numDigits = ceil(log10(prime)); %calculate the number of digits in the prime less one
       powersOfTen = 10.^(0:numDigits); %cache the needed powers of ten
       
       leftTruncated = mod(prime,powersOfTen); %generate a list of numbers by repeatedly left truncating the prime
 
       %leading zeros will cause duplicate entries thus it is possible to
       %detect leading zeros if we rotate the list to the left or right
       %and check for any equivalences with the original list
       hasLeadingZeros = any( circshift(leftTruncated,[0 1]) == leftTruncated ); 
       
       if( hasLeadingZeros || not(checkLeftTruncatable) )
           leftTruncatable = false;
       else
           %check if all of the left truncated numbers are prime
           leftTruncatable = all(isprime(leftTruncated(2:end)));
       end
       if( checkRightTruncatable )
           rightTruncated = (prime - leftTruncated) ./ powersOfTen; %generate a list of right truncated numbers
           rightTruncatable = all(isprime(rightTruncated(1:end-1))); %check if all the right truncated numbers are prime
       else
           rightTruncatable = false;
       end
   end %isTruncatable()
   nums = primes(boundary); %generate all primes <= boundary
   %Flags that indicate if the largest left or right truncatable prime has not
   %been found
   leftTruncateNotFound = true;
   rightTruncateNotFound = true;
   for prime = nums(end:-1:1) %Search through primes in reverse order
       %Get if the prime is left and/or right truncatable, ignoring
       %checking for right truncatable if it has already been found
       [leftTruncatable,rightTruncatable] = isTruncatable(prime,leftTruncateNotFound,rightTruncateNotFound);
       if( leftTruncateNotFound && leftTruncatable ) %print out largest left truncatable prime
           display([num2str(prime) ' is the largest left truncatable prime <= ' num2str(boundary) '.']);
           leftTruncateNotFound = false;
       end
       if( rightTruncateNotFound && rightTruncatable ) %print out largest right truncatable prime
           display([num2str(prime) ' is the largest right truncatable prime <= ' num2str(boundary) '.']);
           rightTruncateNotFound = false;
       end
       %Terminate loop when the largest left and right truncatable primes have
       %been found
       if( not(leftTruncateNotFound || rightTruncateNotFound) )
           break;
       end
   end

end </lang> Solution for n = 1,000,000: <lang MATLAB> >> largestTruncatablePrimes(1e6) 998443 is the largest left truncatable prime <= 1000000. 739399 is the largest right truncatable prime <= 1000000. </lang>

ooRexx

<lang ooRexx> -- find largest left- & right-truncatable primes < 1 million. -- an initial set of primes (not, at this time, we leave out 2 because -- we'll automatically skip the even numbers. No point in doing a needless -- test each time through primes = .array~of(3, 5, 7, 11)

-- check all of the odd numbers up to 1,000,000 loop j = 13 by 2 to 1000000

 loop i = 1 to primes~size
     prime = primes[i]
     -- found an even prime divisor
     if j // prime == 0 then iterate j
     -- only check up to the square root
     if prime*prime > j then leave
 end
 -- we only get here if we don't find a divisor
 primes~append(j)

end

-- get a set of the primes that we can test more efficiently primeSet = .set~of(2) primeSet~putall(primes)


say 'The last prime is' primes[primes~last] "("primeSet~items 'primes under one million).' say copies('-',66)

lastLeft = 0

-- we're going to use the array version to do these in order. We're still -- missing "2", but that's not going to be the largest loop prime over primes

   -- values containing 0 can never work
   if prime~pos(0) \= 0 then iterate
   -- now start the truncations, checking against our set of
   -- known primes
   loop i = 1 for prime~length - 1
       subprime = prime~right(i)
       -- not in our known set, this can't work
       if \primeset~hasIndex(subprime) then iterate prime
   end
   -- this, by definition, with be the largest left-trunc prime
   lastLeft = prime

end -- now look for right-trunc primes lastRight = 0 loop prime over primes

   -- values containing 0 can never work
   if prime~pos(0) \= 0 then iterate
   -- now start the truncations, checking against our set of
   -- known primes
   loop i = 1 for prime~length - 1
       subprime = prime~left(i)
       -- not in our known set, this can't work
       if \primeset~hasIndex(subprime) then iterate prime
   end
   -- this, by definition, with be the largest left-trunc prime
   lastRight = prime

end

say 'The largest left-truncatable prime is' lastLeft '(under one million).' say 'The largest right-truncatable prime is' lastRight '(under one million).'

</lang> Output:

The last prime is 999983 (78498 primes under one million).
------------------------------------------------------------------
The largest  left-truncatable prime is 998443 (under one million).
The largest right-truncatable prime is 739399 (under one million).

OpenEdge/Progress

<lang progress>FUNCTION isPrime RETURNS LOGICAL (

  i_i AS INT

):

  DEF VAR ii AS INT.
  DO ii = 2 TO SQRT( i_i ):
     IF i_i MODULO ii = 0 THEN
        RETURN FALSE.
  END.
  RETURN TRUE AND i_i > 1.

END FUNCTION. /* isPrime */

FUNCTION isLeftTruncatablePrime RETURNS LOGICAL (

  i_i AS INT

):

  DEF VAR ii        AS INT.
  DEF VAR cc        AS CHAR.
  DEF VAR lresult   AS LOGICAL INITIAL TRUE.
  
  cc = STRING( i_i ).
  DO WHILE cc > "":
     lresult = lresult AND isPrime( INTEGER( cc ) ).
     cc = SUBSTRING( cc, 2 ).
  END.
  RETURN lresult.

END FUNCTION. /* isLeftTruncatablePrime */

FUNCTION isRightTruncatablePrime RETURNS LOGICAL (

  i_i AS INT

):

  DEF VAR ii        AS INT.
  DEF VAR cc        AS CHAR.
  DEF VAR lresult   AS LOGICAL INITIAL TRUE.
  
  cc = STRING( i_i ).
  DO WHILE cc > "":
     lresult = lresult AND isPrime( INTEGER( cc ) ).
     cc = SUBSTRING( cc, 1, LENGTH( cc ) - 1 ).
  END.
  RETURN lresult.

END FUNCTION. /* isRightTruncatablePrime */

FUNCTION getHighestTruncatablePrimes RETURNS CHARACTER (

  i_imax AS INTEGER

):

  DEF VAR ii        AS INT.
  DEF VAR ileft     AS INT.
  DEF VAR iright    AS INT.
  DO ii = i_imax TO 1 BY -1 WHILE ileft = 0 OR iright = 0:
     IF INDEX( STRING( ii ), "0" ) = 0 THEN DO:
        IF ileft = 0 AND isLeftTruncatablePrime( ii ) THEN
           ileft = ii.
        IF iright = 0 AND isRightTruncatablePrime( ii ) THEN
           iright = ii.
     END.
  END.
  RETURN SUBSTITUTE("Left: &1~nRight: &2", ileft, iright ).

END FUNCTION. /* getHighestTruncatablePrimes */

MESSAGE

  getHighestTruncatablePrimes( 1000000 )

VIEW-AS ALERT-BOX.

                         </lang>

Output:

---------------------------
Message
---------------------------
Left: 998443
Right: 739399
---------------------------
OK   
---------------------------

PARI/GP

This version builds the truncatable primes with up to k digits in a straightforward fashion. Run time is about 15 milliseconds, almost all of which is I/O. <lang parigp>left(n)={ my(v=[2,3,5,7],u,t=1,out=0); for(i=1,n, t*=10; u=[]; for(j=1,#v, forstep(a=t,t*9,t, if(isprime(a+v[j]),u=concat(u,a+v[j])) ) ); out=v[#v]; v=vecsort(u) ); out }; right(n)={ my(v=[2,3,5,7],u,out=0); for(i=1,n, u=[]; for(j=1,#v, forstep(a=1,9,[2,4], if(isprime(10*v[j]+a),u=concat(u,10*v[j]+a)) ) ); out=v[#v]; v=u ); out }; [left(6),right(6)]</lang>

Perl

<lang perl>#!/usr/bin/perl use warnings; use strict;

use constant {

   LEFT  => 0,
   RIGHT => 1,

};

{ my @primes = (2, 3);

   sub is_prime {
       my $n = shift;
       return if $n < 2;
       for my $prime (@primes) {
           last if $prime >= $n;
           return unless $n % $prime;
       }
       my $sqrt = sqrt $n;
       while ($primes[-1] < $sqrt) {
           my $new = 2 + $primes[-1];
           $new += 2 until is_prime($new);
           push @primes, $new;
           return unless $n % $new;
       }
       return 1;
   }

}


sub trunc {

   my ($n, $side) = @_;
   substr $n, $side == LEFT ? 0 : -1, 1, q();
   return $n;

}


sub is_tprime {

   my ($n, $side) = @_;
   return (is_prime($n)
           and (1 == length $n or is_tprime(trunc($n, $side), $side)));

}


my $length = 6; my @tprimes = ('9' x $length) x 2; for my $side (LEFT, RIGHT) {

   $tprimes[$side] -= 2 until -1 == index $tprimes[$side], '0'
                              and is_tprime($tprimes[$side], $side);

}

print 'left ', join(', right ', @tprimes), "\n"; </lang>

Output:
left 998443, right 739399

Perl 6

<lang perl6>my @primes := 2, 3, 5, -> $p { ($p+2, $p+4 ... &prime)[*-1] } ... *; my @isprime = False,False; # 0 and 1 are not primes by definition sub prime($i) { @isprime[$i] //= ($i %% none @primes ...^ * > $_ given $i.sqrt.floor) }

sub ltp {

   for 9...1 -> $a {
       for 9...1 -> $b {
           for 9...1 -> $c {
               for 9...1 -> $d {
                   for 9...1 -> $e {
                       for 9,7,3 -> $f {
                           my @x := [\+] $f, $e, $d, $c, $b, $a Z* (1,10,100 ... *);
                           return @x[*-1] if not grep {not prime $^n}, @x;
                       }
                   }
               }
           }
       }
   }

}

sub infix:<*+> ($a,$b) { $a * 10 + $b }

sub rtp {

   for 7,5,3 {

for grep &prime, ($_ X*+ 9,7,3,1) { for grep &prime, ($_ X*+ 9,7,3,1) { for grep &prime, ($_ X*+ 9,7,3,1) { for grep &prime, ($_ X*+ 9,7,3,1) { for grep &prime, ($_ X*+ 9,7,3,1) { return $_; } } } } }

   }

}

say "Highest ltp: ", ltp; say "Highest rtp: ", rtp;</lang>

Output:
Highest ltp: 998443
Highest rtp: 739399

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)

PL/I

<lang PL/I> tp: procedure options (main);

   declare primes(1000000) bit (1);
   declare max_primes fixed binary (31);
   declare (i, k) fixed binary (31);
   max_primes = hbound(primes, 1);
   call sieve;
  /* Now search for primes that are right-truncatable. */
  call right_truncatable;
  /* Now search for primes that are left-truncatable. */
  call left_truncatable;

right_truncatable: procedure;

  declare direction bit (1);
  declare (i, k) fixed binary (31);

test_truncatable:

  do i = max_primes to 2 by -1;
     if primes(i) then /* it's a prime */
        do;
           k = i/10;
           do while (k > 0);
              if ^primes(k) then iterate test_truncatable;
              k = k/10;
           end;
           put skip list (i || ' is right-truncatable');
           return;
        end;
  end;

end right_truncatable;

left_truncatable: procedure;

  declare direction bit (1);
  declare (i, k, d, e) fixed binary (31);

test_truncatable:

  do i = max_primes to 2 by -1;
     if primes(i) then /* it's a prime */
        do;
           k = i;
           do d = 100000 repeat d/10 until (d = 10);
              e = k/d;
              k = k - e*d;
              if e = 0 then iterate test_truncatable;
              if ^primes(k) then iterate test_truncatable;
           end;
           put skip list (i || ' is left-truncatable');
           return;
        end;
  end;

end left_truncatable;

sieve: procedure;

  declare (i, j) fixed binary (31);
  primes = '1'b; primes(1) = '0'b;
  do i = 2 to sqrt(max_primes);
     do j = i+i to max_primes by i;
        primes(j) = '0'b;
     end;
  end;

end sieve;

end tp; </lang>

        739399 is right-truncatable
        998443 is left-truncatable

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)

Racket

<lang racket>

  1. lang racket

(require math/number-theory)

(define (truncate-right n)

 (quotient n 10))

(define (truncate-left n)

 (define s (number->string n))
 (string->number (substring s 1 (string-length s))))

(define (contains-zero? n)

 (member #\0 (string->list (number->string n))))

(define (truncatable? truncate n)

 (and (prime? n)
      (not (contains-zero? n))
      (or (< n 10)
          (truncatable? truncate (truncate n)))))
largest left truncatable prime

(for/first ([n (in-range 1000000 1 -1)]

           #:when (truncatable? truncate-left n))
 n)
largest right truncatable prime

(for/first ([n (in-range 1000000 1 -1)]

           #:when (truncatable? truncate-right n))
 n)
Output

998443 739399 </lang>

REXX

A little extra code was added to the prime number generator to speed it up. <lang REXX>/*REXX pgm finds largest left- and right-truncatable primes < 1 million.*/ !.=0 /*placeholders for primes. */ p.1=2; p.2=3; p.3=5; p.4=7; p.5=11; p.6=13; p.7=17 /*some low primes.*/ !.2=1; !.3=1; !.4=1; !.7=1; !.11=1; !.13=1; !.17=1 /*low prime flags.*/ n=7 /*number of primes so far. */

    do j=p.n+2  by 2  to 1000000      /*find all primes < 1,000,000.   */
    if j//3      ==0 then iterate     /*divisible by three?            */
    if right(j,1)==5 then iterate     /*right-most digit a five?       */
    if j//7      ==0 then iterate     /*divisible by seven?            */
    if j//11     ==0 then iterate     /*divisible by eleven?           */
                                      /*the above 4 lines saves time.  */
          do k=6  while p.k**2<=j     /*divide by known odd primes.    */
          if j//p.k==0 then iterate j /*Is divisible by X?   Not prime.*/
          end   /*k*/
    n=n+1                             /*bump number of primes found.   */
    p.n=j                             /*assign to sparse array.        */
    !.j=1                             /*indicate that   J   is a prime.*/
    end         /*j*/

say 'The last prime is' p.n " (there are "n 'primes under one million).' say copies('─',70) /*show a separator line. */ lp=0; rp=0

 do L=n  by -1  until lp\==0;         if pos(0,p.L)\==0  then iterate
          do k=1  for length(p.L)-1;  _=right(p.L,k)    /*truncate a #.*/
          if \!._  then iterate L     /*Truncated #  ¬prime?   Skip it.*/
          end   /*k*/
 lp=p.L
 end            /*L*/
 do R=n  by -1  until rp\==0;         if pos(0,p.R)\==0  then iterate
          do k=1  for length(p.R)-1;  _=left(p.R,k)     /*truncate a #.*/
          if \!._  then iterate R     /*Truncated #  ¬prime?   Skip it.*/
          end   /*k*/
 rp=p.R
 end            /*R*/

say 'The largest left-truncatable prime under one million is ' lp say 'The largest right-truncatable prime under one million is ' rp

                                      /*stick a fork in it, we're done.*/</lang>

output

The last prime is 999983  (there are 78498 primes under one million).
──────────────────────────────────────────────────────────────────────
The largest  left-truncatable prime under one million is  998443
The largest right-truncatable prime under one million is  739399

Ruby

<lang ruby>def left_truncatable?(n)

 return truncatable?(n, $left_truncate)

end

$left_truncate = proc do |n|

 begin
   n = Integer(String(n)[1..-1])
 rescue ArgumentError
   n = 0
 end
 n

end

def right_truncatable?(n)

 return truncatable?(n, $right_truncate)

end

$right_truncate = proc {|n| n/10}

def truncatable?(n, trunc_func)

 return false if String(n).include? "0"
 loop do
   n = trunc_func.call(n)
   return true if n == 0
   return false if not Prime.prime?(n)
 end

end

require 'prime' primes = Prime.each(1_000_000).to_a.reverse

p primes.detect {|p| left_truncatable? p} p primes.detect {|p| right_truncatable? p}</lang>

returns

998443
739399

An Alternative Approach

Setting BASE to 10 and MAX to 6 in the Ruby example here Produces:

The largest left truncatable prime less than 1000000 in base 10 is 998443

Tcl

<lang tcl>package require Tcl 8.5

  1. 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

}

  1. 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

XPL0

<lang XPL0>code CrLf=9, IntOut=11;

func Prime(P); \Return true if P is a prime number int P; \(1 is not prime, but 2 is, etc.) int I; [if P<=1 then return false; \negative numbers are not prime for I:= 2 to sqrt(P) do

       if rem(P/I) = 0 then return false;

return true; ];

func RightTrunc(N); \Return largest right-truncatable prime < one million int N; int M; [for N:= 1_000_000-1 downto 2 do

       [M:= N;
       loop    [if not Prime(M) then quit;
               M:= M/10;
               if rem(0) = 0 then quit;        \no zeros allowed
               if M=0 then return N;
               ];
       ];

];

func LeftTrunc(N); \Return largest left-truncatable prime < one million int N; int M, P; [for N:= 1_000_000-1 downto 2 do

       [M:= N;
       P:=100_000;
       loop    [if not Prime(M) then quit;
               M:= rem(M/P);
               P:= P/10;
               if M<P then quit;               \no zeros allowed
               if M=0 then return N;
               ];
       ];

];

[IntOut(0, LeftTrunc); CrLf(0);

IntOut(0, RightTrunc); CrLf(0);

]</lang>

Output:

998443
739399