June 2018 Update

Task/Truncatable-primes/Factor/truncatable-primes.factor

@@ -0,0 +1,36 @@
+USING: formatting fry grouping.extras kernel literals math
+math.parser math.primes sequences ;
+IN: rosetta-code.truncatable-primes
+
+CONSTANT: primes $[ 1,000,000 primes-upto reverse ]
+
+: number>digits ( n -- B{} ) number>string string>digits ;
+
+: no-zeros? ( seq -- ? ) [ zero? not ] all? ;
+
+: all-prime? ( seq -- ? ) [ prime? ] all? ;
+
+: truncate ( seq quot -- seq' ) call( seq -- seq' )
+    [ 10 digits>integer ] map ;
+
+: truncate-right ( seq -- seq' ) [ head-clump ] truncate ;
+
+: truncate-left ( seq -- seq' ) [ tail-clump ] truncate ;
+
+: truncatable-prime? ( n quot -- ? ) [ number>digits ] dip
+    '[ @ all-prime? ] [ no-zeros? ] bi and ; inline
+
+: right-truncatable-prime? ( n -- ? ) [ truncate-right ]
+    truncatable-prime? ;
+
+: left-truncatable-prime? ( n -- ? ) [ truncate-left ]
+    truncatable-prime? ;
+
+: find-truncatable-primes ( -- ltp rtp )
+    primes [ [ left-truncatable-prime?  ] find nip ]
+           [ [ right-truncatable-prime? ] find nip ] bi ;
+
+: main ( -- ) find-truncatable-primes
+    "Left: %d\nRight: %d\n" printf ;
+
+MAIN: main

Task/Truncatable-primes/Maple/truncatable-primes.maple

@@ -0,0 +1,50 @@
+MaxTruncatablePrime := proc({left::truefalse:=FAIL, right::truefalse:=FAIL}, $)
+local i, j, c, p, b, n, sdprimes, dir;
+local tprimes := table();
+    if left = true and right = true then
+        error "invalid input";
+    elif right = true then
+        dir := "right";
+    else
+        dir := "left";
+    end if;
+    b := 10;
+    n := 6;
+    sdprimes := select(isprime, [seq(1..b-1)]);
+    for p in sdprimes do
+        if assigned(tprimes[p]) then
+            next;
+        end if;
+        i := ilog[b](p)+1;
+        j := 1;
+        while p < b^n do
+            if dir = "left" then
+                c := j*b^i + p;
+            else
+                c := p*b + j;
+            end if;
+            if j >= b or c > b^n then # we have tried all 1 digit extensions of p, add p to tprimes and move back 1 digit
+                tprimes[p] := p;
+                if i = 1 then # if we are at the first digit,  go to the next 1 digit prime
+                    break;
+                end if;
+                i := i - 1;
+                j := 1;
+                if dir = "left" then
+                    p := p - iquo(p, b^i)*b^i;
+                else
+                    p := iquo(p, b);
+                end if;
+            elif assigned(tprimes[c]) then
+                j := j + 1;
+            elif isprime(c) then
+                p := c;
+                i := i + 1;
+                j := 1;
+            else
+                j := j+1;
+            end if;
+        end do;
+    end do;
+    return max(indices(tprimes, 'nolist'));
+end proc;

Task/Truncatable-primes/Ring/truncatable-primes.ring

@@ -0,0 +1,56 @@
+# Project : Truncatable primes
+# Date    : 2017/10/15
+# Author : Gal Zsolt (~ CalmoSoft ~)
+# Email   : <calmosoft@gmail.com>
+
+for n = 1000000 to 1 step -1
+    flag = 1
+    flag2 = 1
+    strn = string(n)
+    for nr = 1 to len(strn)
+        if strn[nr] = "0"
+           flag2 = 0
+        ok
+    next
+    if flag2 = 1
+       for m = 1 to len(strn)
+           strp = right(strn, m)
+           if isprime(number(strp))
+           else
+              flag = 0
+              exit
+           ok
+       next
+       if flag = 1
+          nend = n
+          exit
+       ok
+    ok
+next
+see "Largest left truncatable prime : " + nend + nl
+
+for n = 1000000 to 1 step -1
+    flag = 1
+    strn = string(n)
+    for m = 1 to len(strn)
+        strp = left(strn, len(strn) - m + 1)
+        if isprime(number(strp))
+        else
+           flag = 0
+           exit
+        ok
+    next
+    if flag = 1
+       nend = n
+       exit
+    ok
+next
+see "Largest right truncatable prime : " + nend + nl
+
+func isprime num
+     if (num <= 1) return 0 ok
+     if (num % 2 = 0 and num != 2) return 0 ok
+     for i = 3 to floor(num / 2) -1 step 2
+         if (num % i = 0) return 0 ok
+     next
+     return 1