Ormiston pairs

From Rosetta Code
Ormiston pairs is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

An Ormiston pair is two consecutive prime numbers which are anagrams, i.e. contain the same decimal digits but in a different order.


(1913, 1931) is the first such pair.


Task
  • Find and show the first 30 Ormiston pairs.
  • Find and show the count of Ormiston pairs up to one million.


Stretch
  • Find and show the count of Ormiston pairs up to ten million.


See also


ALGOL 68

Works with: ALGOL 68G version Any - tested with release 2.8.3.win32

When running this with ALGOL 68G, you will need to specify a large heap size with e.g., -heap 256M on the ALGOL 68G command.

Uses the "signature" idea from the XPL0 sample and the "difference is 0 MOD 18" filter from the Wren sample.
Also shows the number of prime pairs whose difference is 0 MOD 18 but are not Ormiston pairs.

BEGIN # find some Orimiston pairs - pairs of primes where the first and next  #
      # prime are anagrams                                                    #
    PR read "primes.incl.A68" PR                    # include prime utilities #
    INT max prime  = 10 000 000;            # maximum number we will consider #
    INT max digits = BEGIN                    # count the digits of max prime # 
                        INT v := 1;
                        INT d := 1;
                        WHILE ( v *:= 10 ) < max prime DO d +:= 1 OD;
                        d
                     END;
    [ 0 : 9 ]LONG INT dp;  # table of max digit powers for signature creation #
    dp[ 0 ] := 1; FOR i TO UPB dp DO dp[ i ] := max digits * dp[ i - 1 ] OD;
    []BOOL prime      = PRIMESIEVE max prime;
    # construct a list of the primes up to the maximum prime to consider      #
    []INT  prime list = EXTRACTPRIMESUPTO max prime FROMPRIMESIEVE prime;
    # splits n into its digits, returning the sum of their counts, each       #
    # scaled by the digit power of max digits                                 #
    PROC get digits = ( INT n )LONG INT:
         BEGIN
            INT      v      := n;
            LONG INT result := dp[ v MOD 10 ];
            WHILE ( v OVERAB 10 ) > 0 DO
                result +:= dp[ v MOD 10 ]
            OD;
            result
         END # get digits # ;
    # count the Ormiston pairs                                                #
    INT o count := 0;
    INT n count := 0;
    INT p10     := 100 000;
    FOR i TO UPB prime list - 1 DO
        INT p1 = prime list[ i     ];
        INT p2 = prime list[ i + 1 ];
        IF ( p2 - p1 ) MOD 18 = 0 THEN
            # p2 and p1 might be anagrams                                     #
            IF get digits( p1 ) /= get digits( p2 ) THEN
                # not an Ormiston pair afterall                               #
                n count +:= 1
            ELSE
                # p1 and p2 are an Ormiston pair                              #
                o count +:= 1;
                IF o count <= 30 THEN
                    print( ( " (", whole( p1, -5 ), ", ", whole( p2, -5 ), ")"
                           , IF o count MOD 3 = 0 THEN newline ELSE " " FI
                           )
                         )
                ELIF p1 >= p10 THEN
                    print( ( whole( o count - 1, -9 )
                           , " Ormiston pairs below "
                           , whole( p10, 0 )
                           , newline
                           )
                         );
                    p10 *:= 10
                FI
            FI
        FI
    OD;
    print( ( whole( o count, -9 ), " Ormiston pairs below ", whole( max prime, 0 ), newline ) );
    print( ( whole( n count, -9 ), " non-Ormiston ""0 MOD 18"" pairs bwlow ", whole( max prime, 0 ) ) )
END
Output:
 ( 1913,  1931)  (18379, 18397)  (19013, 19031)
 (25013, 25031)  (34613, 34631)  (35617, 35671)
 (35879, 35897)  (36979, 36997)  (37379, 37397)
 (37813, 37831)  (40013, 40031)  (40213, 40231)
 (40639, 40693)  (45613, 45631)  (48091, 48109)
 (49279, 49297)  (51613, 51631)  (55313, 55331)
 (56179, 56197)  (56713, 56731)  (58613, 58631)
 (63079, 63097)  (63179, 63197)  (64091, 64109)
 (65479, 65497)  (66413, 66431)  (74779, 74797)
 (75913, 75931)  (76213, 76231)  (76579, 76597)
       40 Ormiston pairs below 100000
      382 Ormiston pairs below 1000000
     3722 Ormiston pairs below 10000000
    53369 non-Ormiston "0 MOD 18" pairs bwlow 10000000

AppleScript

use AppleScript version "2.4" -- Mac OS X 10.10 (Yosemite) or later.
use sorter : script "Insertion sort" -- <https://rosettacode.org/wiki/Sorting_algorithms/Insertion_sort#AppleScript>

on OrmistonPairs()
    script o
        property primes : sieveOfSundaram(13, 10000000)
    end script
    
    set output to {"First 30 Ormiston pairs:"}
    set outputLine to {}
    set p1 to missing value
    set digits1 to {}
    set counter to 0
    repeat with p2 in o's primes
        set p2 to p2's contents
        set p to p2
        set digits2 to {}
        repeat until (p = 0)
            set end of digits2 to p mod 10
            set p to p div 10
        end repeat
        tell sorter to sort(digits2, 1, -1)
        if (digits2 = digits1) then
            if (counter < 30) then
                set end of outputLine to ("{" & p1) & (", " & p2 & "}")
                if ((count outputLine) = 6) then
                    set end of output to join(outputLine, "  ")
                    set outputLine to {}
                end if
            end if
            set counter to counter + 1
        end if
        if ((p2 > 1000000) and (p1 < 1000000)) then ¬
            set end of output to "Number of pairs < 1,000,000: " & counter
        set p1 to p2
        set digits1 to digits2
    end repeat
    set end of output to "Number of pairs < 10,000,000: " & counter
    
    return join(output, linefeed)
end OrmistonPairs

on sieveOfSundaram(lowerLimit, upperLimit)
    if (upperLimit < lowerLimit) then set {upperLimit, lowerLimit} to {lowerLimit, upperLimit}
    if (upperLimit < 2) then return {}
    if (lowerLimit < 2) then set lowerLimit to 2
    
    set k to (upperLimit - 1) div 2
    set shift to lowerLimit div 2 - 1
    script o
        property sieve : makeList(k - shift, true)
        
        on zapMultiples(n)
            set i to (n * n) div 2
            if (i  shift) then set i to shift + n - (shift - i) mod n
            repeat with i from (i - shift) to (k - shift) by n
                set my sieve's item i to false
            end repeat
        end zapMultiples
    end script
    
    o's zapMultiples(3)
    set addends to {2, 6, 8, 12, 14, 18, 24, 26}
    repeat with n from 5 to (upperLimit ^ 0.5 div 1) by 30
        o's zapMultiples(n)
        repeat with a in addends
            o's zapMultiples(n + a)
        end repeat
    end repeat
    
    repeat with i from 1 to (k - shift)
        if (o's sieve's item i) then set o's sieve's item i to (i + shift) * 2 + 1
    end repeat
    set o's sieve to o's sieve's numbers
    if (lowerLimit is 2) then set o's sieve's beginning to 2
    
    return o's sieve
end sieveOfSundaram

on makeList(limit, filler)
    if (limit < 1) then return {}
    script o
        property lst : {filler}
    end script
    
    set counter to 1
    repeat until (counter + counter > limit)
        set o's lst to o's lst & o's lst
        set counter to counter + counter
    end repeat
    if (counter < limit) then set o's lst to o's lst & o's lst's items 1 thru (limit - counter)
    return o's lst
end makeList

on join(lst, delim)
    set astid to AppleScript's text item delimiters
    set AppleScript's text item delimiters to delim
    set txt to lst as text
    set AppleScript's text item delimiters to astid
    return txt
end join

OrmistonPairs()
Output:
"First 30 Ormiston pairs:
{1913, 1931}  {18379, 18397}  {19013, 19031}  {25013, 25031}  {34613, 34631}  {35617, 35671}
{35879, 35897}  {36979, 36997}  {37379, 37397}  {37813, 37831}  {40013, 40031}  {40213, 40231}
{40639, 40693}  {45613, 45631}  {48091, 48109}  {49279, 49297}  {51613, 51631}  {55313, 55331}
{56179, 56197}  {56713, 56731}  {58613, 58631}  {63079, 63097}  {63179, 63197}  {64091, 64109}
{65479, 65497}  {66413, 66431}  {74779, 74797}  {75913, 75931}  {76213, 76231}  {76579, 76597}
Number of pairs < 1,000,000: 382
Number of pairs < 10,000,000: 3722"

Arturo

nextPrime: $[n][
    ensure -> and? n > 2 odd? n
    range .step:2 2+n  | select.first => prime?
                        | last
]

anagrams?: $[a b] [equal? tally to :string a tally to :string b]

ormiston?: $[n] [and? -> prime? n -> anagrams? n nextPrime n]

print "First 30 Ormiston pairs:"
range .step: 2 3  | select .first:30 => ormiston?
                   | map 'x -> @[x nextPrime x]
                   | loop [a b c d e] -> print [a b c d e]

count: range .step: 2 3 1e6 | enumerate => ormiston?
print ~"\n|count| ormiston pairs less than a million"
Output:
First 30 Ormiston pairs:
[1913 1931] [18379 18397] [19013 19031] [25013 25031] [34613 34631] 
[35617 35671] [35879 35897] [36979 36997] [37379 37397] [37813 37831] 
[40013 40031] [40213 40231] [40639 40693] [45613 45631] [48091 48109] 
[49279 49297] [51613 51631] [55313 55331] [56179 56197] [56713 56731] 
[58613 58631] [63079 63097] [63179 63197] [64091 64109] [65479 65497] 
[66413 66431] [74779 74797] [75913 75931] [76213 76231] [76579 76597] 

382 ormiston pairs less than a million

C

Translation of: Wren
#include <stdio.h>
#include <stdlib.h>
#include <stdbool.h>
#include <locale.h>

bool *sieve(int limit) {
    int i, p;
    limit++;
    // True denotes composite, false denotes prime.
    bool *c = calloc(limit, sizeof(bool)); // all false by default
    c[0] = true;
    c[1] = true;
    for (i = 4; i < limit; i += 2) c[i] = true;
    p = 3; // Start from 3.
    while (true) {
        int p2 = p * p;
        if (p2 >= limit) break;
        for (i = p2; i < limit; i += 2 * p) c[i] = true;
        while (true) {
            p += 2;
            if (!c[p]) break;
        }
    }
    return c;
}

typedef struct {
    char digs[20];
    int count;
} digits;

digits getDigits(int n) {
    if (n == 0) return (digits){ {0}, 1 };
    digits d;
    d.count = 0;
    while (n > 0) {
        d.digs[d.count++] = n % 10;
        n = n / 10;
    }
    return d; // note digits are in reverse order
}

typedef struct {
    int x;
    int y;
} pair;

int main() {
    const int limit = 1000000000;
    int i, j, k, pc = 0, count = 0, count2 = 0, p1, p2, key1, key2;
    digits d;
    bool *c = sieve(limit);
    for (i = 0; i < limit; ++i) {
        if (!c[i]) ++pc;
    }
    int *primes = (int *)malloc(pc * sizeof(int));
    for (i = 0, j = 0; i < limit; ++i) {
        if (!c[i]) primes[j++] = i;
    }
    pair orm30[30];
    int counts[5];
    j = 100000;
    for (i = 0; i < pc-1; ++i) {
        p1 = primes[i];
        p2 = primes[i+1];
        if ((p2 - p1) % 18) continue;
        key1 = 1;
        d = getDigits(p1);
        for (k = 0; k < d.count; ++k) key1 *= primes[d.digs[k]];
        key2 = 1;
        d = getDigits(p2);
        for (k = 0; k < d.count; ++k) key2 *= primes[d.digs[k]];
        if (key1 == key2) {
            if (count < 30) orm30[count] = (pair){p1, p2};
            if (p1 >= j) {
                counts[count2++] = count;
                j *= 10;
            }
            ++count;
        }
    }
    counts[count2] = count;
    printf("First 30 Ormiston pairs:\n");
    setlocale(LC_NUMERIC, "");
    for (i = 0; i < 30; ++i) {
        printf("[%'6d, %'6d] ", orm30[i].x, orm30[i].y);
        if (!((i+1) % 3)) printf("\n");
    }
    printf("\n");
    j = 100000;
    for (i = 0; i < 5; ++i) {
        printf("%'d Ormiston pairs before %'d\n", counts[i], j);
        j *= 10;
    }
    free(c);
    free(primes);
    return 0;
}
Output:
First 30 Ormiston pairs:
[ 1,913,  1,931] [18,379, 18,397] [19,013, 19,031] 
[25,013, 25,031] [34,613, 34,631] [35,617, 35,671] 
[35,879, 35,897] [36,979, 36,997] [37,379, 37,397] 
[37,813, 37,831] [40,013, 40,031] [40,213, 40,231] 
[40,639, 40,693] [45,613, 45,631] [48,091, 48,109] 
[49,279, 49,297] [51,613, 51,631] [55,313, 55,331] 
[56,179, 56,197] [56,713, 56,731] [58,613, 58,631] 
[63,079, 63,097] [63,179, 63,197] [64,091, 64,109] 
[65,479, 65,497] [66,413, 66,431] [74,779, 74,797] 
[75,913, 75,931] [76,213, 76,231] [76,579, 76,597] 

40 Ormiston pairs before 100,000
382 Ormiston pairs before 1,000,000
3,722 Ormiston pairs before 10,000,000
34,901 Ormiston pairs before 100,000,000
326,926 Ormiston pairs before 1,000,000,000

C++

Library: Primesieve
#include <array>
#include <iomanip>
#include <iostream>
#include <utility>

#include <primesieve.hpp>

class ormiston_pair_generator {
public:
    ormiston_pair_generator() { prime_ = pi_.next_prime(); }
    std::pair<uint64_t, uint64_t> next_pair() {
        for (;;) {
            uint64_t prime = prime_;
            auto digits = digits_;
            prime_ = pi_.next_prime();
            digits_ = get_digits(prime_);
            if (digits_ == digits)
                return std::make_pair(prime, prime_);
        }
    }

private:
    static std::array<int, 10> get_digits(uint64_t n) {
        std::array<int, 10> result = {};
        for (; n > 0; n /= 10)
            ++result[n % 10];
        return result;
    }
    primesieve::iterator pi_;
    uint64_t prime_;
    std::array<int, 10> digits_;
};

int main() {
    ormiston_pair_generator generator;
    int count = 0;
    std::cout << "First 30 Ormiston pairs:\n";
    for (; count < 30; ++count) {
        auto [p1, p2] = generator.next_pair();
        std::cout << '(' << std::setw(5) << p1 << ", " << std::setw(5) << p2
                  << ')' << ((count + 1) % 3 == 0 ? '\n' : ' ');
    }
    std::cout << '\n';
    for (uint64_t limit = 1000000; limit <= 1000000000; ++count) {
        auto [p1, p2] = generator.next_pair();
        if (p1 > limit) {
            std::cout << "Number of Ormiston pairs < " << limit << ": " << count
                      << '\n';
            limit *= 10;
        }
    }
}
Output:
First 30 Ormiston pairs:
( 1913,  1931) (18379, 18397) (19013, 19031)
(25013, 25031) (34613, 34631) (35617, 35671)
(35879, 35897) (36979, 36997) (37379, 37397)
(37813, 37831) (40013, 40031) (40213, 40231)
(40639, 40693) (45613, 45631) (48091, 48109)
(49279, 49297) (51613, 51631) (55313, 55331)
(56179, 56197) (56713, 56731) (58613, 58631)
(63079, 63097) (63179, 63197) (64091, 64109)
(65479, 65497) (66413, 66431) (74779, 74797)
(75913, 75931) (76213, 76231) (76579, 76597)

Number of Ormiston pairs < 1000000: 382
Number of Ormiston pairs < 10000000: 3722
Number of Ormiston pairs < 100000000: 34901
Number of Ormiston pairs < 1000000000: 326926

Delphi

Works with: Delphi version 6.0

Uses iterator to do both the first 30 and the millionth and 10 millionth pair. It is an easy way to make the same code do both showing a number of pairs and picking counts out of different points in the iteration.

{------- These subroutines would normally be in libraries, but they are included here for clairty------------- }

function IsPrime(N: int64): boolean;
{Fast, optimised prime test}
var I,Stop: int64;
begin
if (N = 2) or (N=3) then Result:=true
else if (n <= 1) or ((n mod 2) = 0) or ((n mod 3) = 0) then Result:= false
else
     begin
     I:=5;
     Stop:=Trunc(sqrt(N+0.0));
     Result:=False;
     while I<=Stop do
           begin
           if ((N mod I) = 0) or ((N mod (I + 2)) = 0) then exit;
           Inc(I,6);
           end;
     Result:=True;
     end;
end;


function GetNextPrime(Start: integer): integer;
{Get the next prime number after Start}
begin
repeat Inc(Start)
until IsPrime(Start);
Result:=Start;
end;

{-----------------------------------------------------------------------------------------------------}


type TPrimeInfo = record
 Prime1,Prime2: integer;
 Count: integer;
 end;

type TOrmIterator = class(TObject)
  Info: TPrimeInfo;
 private
  function IsOrmistonPair(P1, P2: integer): boolean;
 protected
 public
  procedure Reset;
  function GetNext: TPrimeInfo;
 end;


function TOrmIterator.IsOrmistonPair(P1,P2: integer): boolean;
{Tests if P1 and P2 primes represent Ormiston Pairs}
{I}
var S1,S2: string;
var I,J: integer;
var SL1,SL2: TStringList;
begin
Result:=False;
SL1:=TStringList.Create;
SL2:=TStringList.Create;
try
{Copy characters in numbers into string lists}
SL1.Duplicates:=dupAccept;
SL2.Duplicates:=dupAccept;
S1:=IntToStr(P1); S2:=IntToStr(P2);
for I:=1 to Length(S1) do SL1.Add(S1[I]);
for I:=1 to Length(S2) do SL2.Add(S2[I]);
{Sort them }
SL1.Sort; SL2.Sort;
{And compare them item for item - any mismatch = not Ormiston Pair }
for I:=0 to Min(SL1.Count,SL2.Count)-1 do
 if SL1[I]<>SL2[I] then exit;
Result:=True;
finally Sl1.Free; SL2.Free; end;
end;


procedure TOrmIterator.Reset;
{Restart iterator}
begin
Info.Count:=0;
Info.Prime1:=1; Info.Prime2:=3;
end;


function TOrmIterator.GetNext: TPrimeInfo;
{Iterate to next Ormiston Pair}
begin
while true do
	begin
	Info.Prime2:=GetNextPrime(Info.Prime1);
	if IsOrmistonPair(Info.Prime1,Info.Prime2) then
		begin
		Inc(Info.Count);
		Result:=Info;
		Info.Prime1:=Info.Prime2;
		break;
		end
	else Info.Prime1:=Info.Prime2;
	end;
end;


procedure ShowOrmistonPairs(Memo: TMemo);
var I: integer;
var S: string;
var OI: TOrmIterator;
var Info: TPrimeInfo;
begin
{Create iterator}
OI:=TOrmIterator.Create;
try
OI.Reset;
{Iterate throug 1st 30 pairs}
for I:=1 to 30 do
	begin
	Info:=OI.GetNext;
	S:=S+Format('(%6D %6D) ',[Info.Prime1,Info.Prime2]);
	If (Info.Count mod 3)=0 then S:=S+CRLF;
	end;
Memo.Lines.Add(S);
Memo.Lines.Add('Count='+IntToStr(Info.Count));

{iterate to millionth pair}
repeat Info:=OI.GetNext
until Info.Prime2>=1000000;
Memo.Lines.Add('1000,000 ='+IntToStr(Info.Count-1));
{iterate to 10 millionth pair}
repeat Info:=OI.GetNext
until Info.Prime2>=10000000;
Memo.Lines.Add('10,000,000 ='+IntToStr(Info.Count-1));
finally OI.Free; end;
end;
Output:
(  1913   1931) ( 18379  18397) ( 19013  19031) 
( 25013  25031) ( 34613  34631) ( 35617  35671) 
( 35879  35897) ( 36979  36997) ( 37379  37397) 
( 37813  37831) ( 40013  40031) ( 40213  40231) 
( 40639  40693) ( 45613  45631) ( 48091  48109) 
( 49279  49297) ( 51613  51631) ( 55313  55331) 
( 56179  56197) ( 56713  56731) ( 58613  58631) 
( 63079  63097) ( 63179  63197) ( 64091  64109) 
( 65479  65497) ( 66413  66431) ( 74779  74797) 
( 75913  75931) ( 76213  76231) ( 76579  76597) 

Count=30
1000,000 =382
10,000,000 =3722
Elapsed Time: 10.046 Sec.

F#

This task uses Extensible Prime Generator (F#)

// Ormiston pairs. Nigel Galloway: January 31st., 2023
let fG(n,g)=let i=Array.zeroCreate<int>10
            let rec fG n g=if g<10 then i[g]<-n i[g] 1 else i[g%10]<-n i[g%10] 1; fG n (g/10)
            fG (+) n; fG (-) g; Array.forall ((=)0) i
let oPairs n=n|>Seq.pairwise|>Seq.filter fG
primes32()|>oPairs|>Seq.take 30|>Seq.iter(printf "%A "); printfn ""
printfn $"<1 million: %d{primes32()|>Seq.takeWhile((>)1000000)|>oPairs|>Seq.length}"
printfn $"<10 million: %d{primes32()|>Seq.takeWhile((>)10000000)|>oPairs|>Seq.length}"
printfn $"<100 million: %d{primes32()|>Seq.takeWhile((>)100000000)|>oPairs|>Seq.length}"
printfn $"<1 billion: %d{primes32()|>Seq.takeWhile((>)1000000000)|>oPairs|>Seq.length}"
Output:
(1913, 1931) (18379, 18397) (19013, 19031) (25013, 25031) (34613, 34631) (35617, 35671) (35879, 35897) (36979, 36997) (37379, 37397) (37813, 37831) (40013, 40031) (40213, 40231) (40639, 40693) (45613, 45631) (48091, 48109) (49279, 49297) (51613, 51631) (55313, 55331) (56179, 56197) (56713, 56731) (58613, 58631) (63079, 63097) (63179, 63197) (64091, 64109) (65479, 65497) (66413, 66431) (74779, 74797) (75913, 75931) (76213, 76231) (76579, 76597)
<1 million: 382
<10 million: 3722
<100 million: 34901
<1 billion: 326926

Factor

Works with: Factor version 0.99 2022-04-03
USING: grouping io kernel lists lists.lazy math math.parser
math.primes.lists math.statistics prettyprint sequences ;

: ormistons ( -- list )
    lprimes dup cdr lzip
    [ first2 [ >dec histogram ] same? ] lfilter ;

"First 30 Ormiston pairs:" print
30 ormistons ltake list>array 5 group simple-table. nl

ormistons [ first 1e6 < ] lwhile llength pprint bl
"Ormiston pairs less than a million." print
Output:
First 30 Ormiston pairs:
{ 1913 1931 }   { 18379 18397 } { 19013 19031 } { 25013 25031 } { 34613 34631 }
{ 35617 35671 } { 35879 35897 } { 36979 36997 } { 37379 37397 } { 37813 37831 }
{ 40013 40031 } { 40213 40231 } { 40639 40693 } { 45613 45631 } { 48091 48109 }
{ 49279 49297 } { 51613 51631 } { 55313 55331 } { 56179 56197 } { 56713 56731 }
{ 58613 58631 } { 63079 63097 } { 63179 63197 } { 64091 64109 } { 65479 65497 }
{ 66413 66431 } { 74779 74797 } { 75913 75931 } { 76213 76231 } { 76579 76597 }

382 Ormiston pairs less than a million.

FreeBASIC

Translation of: XPL0
#include "isprime.bas"

Function GetSig(Byval N As Integer) As Integer
    Dim As Integer Sig = 0
    Do While N > 0
        Sig += 1 Shl (N Mod 10)
        N \= 10
    Loop
    Return Sig
End Function

Dim As Integer Cnt = 0, N0 = 0, Sig0 = 0, N = 3, Sig
Do
    If isPrime(N) Then
        Sig = GetSig(N)
        If Sig = Sig0 Then
            Cnt += 1
            If Cnt <= 30 Then
                Print Using "##### #####"; N0; N;
                If Cnt Mod 3 = 0 Then Print Else Print "   ";
            End If
        End If
        Sig0 = Sig
        N0 = N
    End If
    If N = 1e5 -1 Then Print !"\nOrmiston pairs up to one hundred thousand: "; Cnt
    If N = 1e6 -1 Then Print "Ormiston pairs up to one million: "; Cnt
    If N = 1e7 -1 Then Print "Ormiston pairs up to ten million: "; Cnt: Exit Do
    N += 2      
Loop

Sleep
Output:
  1913  1931   18379 18397   19013 19031
 25013 25031   34613 34631   35617 35671
 35879 35897   36979 36997   37379 37397
 37813 37831   40013 40031   40213 40231
 40639 40693   45613 45631   48091 48109
 49279 49297   51613 51631   55313 55331
 56179 56197   56713 56731   58613 58631
 63079 63097   63179 63197   64091 64109
 65479 65497   66413 66431   74779 74797
 75913 75931   76213 76231   76579 76597

Ormiston pairs up to one hundred thousand:  40
Ormiston pairs up to one million: 382
Ormiston pairs up to ten million: 3722

Go

Translation of: Wren
Library: Go-rcu
package main

import (
    "fmt"
    "rcu"
)

func main() {
    const limit = 1e9
    primes := rcu.Primes(limit)
    var orm30 [][2]int
    j := int(1e5)
    count := 0
    var counts []int
    for i := 0; i < len(primes)-1; i++ {
        p1 := primes[i]
        p2 := primes[i+1]
        if (p2-p1)%18 != 0 {
            continue
        }
        key1 := 1
        for _, dig := range rcu.Digits(p1, 10) {
            key1 *= primes[dig]
        }
        key2 := 1
        for _, dig := range rcu.Digits(p2, 10) {
            key2 *= primes[dig]
        }
        if key1 == key2 {
            if count < 30 {
                orm30 = append(orm30, [2]int{p1, p2})
            }
            if p1 >= j {
                counts = append(counts, count)
                j *= 10
            }
            count++
        }
    }
    counts = append(counts, count)
    fmt.Println("First 30 Ormiston pairs:")
    for i := 0; i < 30; i++ {
        fmt.Printf("%5v ", orm30[i])
        if (i+1)%3 == 0 {
            fmt.Println()
        }
    }
    fmt.Println()
    j = int(1e5)
    for i := 0; i < len(counts); i++ {
        fmt.Printf("%s Ormiston pairs before %s\n", rcu.Commatize(counts[i]), rcu.Commatize(j))
        j *= 10
    }
}
Output:
First 30 Ormiston pairs:
[ 1913  1931] [18379 18397] [19013 19031] 
[25013 25031] [34613 34631] [35617 35671] 
[35879 35897] [36979 36997] [37379 37397] 
[37813 37831] [40013 40031] [40213 40231] 
[40639 40693] [45613 45631] [48091 48109] 
[49279 49297] [51613 51631] [55313 55331] 
[56179 56197] [56713 56731] [58613 58631] 
[63079 63097] [63179 63197] [64091 64109] 
[65479 65497] [66413 66431] [74779 74797] 
[75913 75931] [76213 76231] [76579 76597] 

40 Ormiston pairs before 100,000
382 Ormiston pairs before 1,000,000
3,722 Ormiston pairs before 10,000,000
34,901 Ormiston pairs before 100,000,000
326,926 Ormiston pairs before 1,000,000,000

Haskell

import Data.List (sort)
import Data.Numbers.Primes (primes)

---------------------- ORMISTON PAIRS --------------------

ormistonPairs :: [(Int, Int)]
ormistonPairs =
  [ (fst a, fst b)
    | (a, b) <- zip primeDigits (tail primeDigits),
      snd a == snd b
  ]

primeDigits :: [(Int, String)]
primeDigits = (,) <*> (sort . show) <$> primes

--------------------------- TEST -------------------------
main :: IO ()
main =
  putStrLn "First 30 Ormiston pairs:"
    >> mapM_ print (take 30 ormistonPairs)
    >> putStrLn "\nCount of Ormistons up to 1,000,000:"
    >> print (length (takeWhile ((<= 1000000) . snd) ormistonPairs))
Output:
First 30 Ormiston pairs:
(1913,1931)
(18379,18397)
(19013,19031)
(25013,25031)
(34613,34631)
(35617,35671)
(35879,35897)
(36979,36997)
(37379,37397)
(37813,37831)
(40013,40031)
(40213,40231)
(40639,40693)
(45613,45631)
(48091,48109)
(49279,49297)
(51613,51631)
(55313,55331)
(56179,56197)
(56713,56731)
(58613,58631)
(63079,63097)
(63179,63197)
(64091,64109)
(65479,65497)
(66413,66431)
(74779,74797)
(75913,75931)
(76213,76231)
(76579,76597)

Count of Ormistons up to 1,000,000:
382

J

For this, we would like to be able to test if a prime number is the first value in an Ormiston pair:

   isorm=: -:&(/:~)&":&> 4 p: ]

We could also use a routine to organize pairs of numbers as moderate width lines of text:

   fmtpairs=: {{ names <@([,',',])&":/"1 y}}

Then the task becomes:

   fmtpairs (,. 4 p:]) p:30{.I. isorm i.&.(p:inv) 1e6
1913,1931   18379,18397 19013,19031 25013,25031 
34613,34631 35617,35671 35879,35897 36979,36997 
37379,37397 37813,37831 40013,40031 40213,40231 
40639,40693 45613,45631 48091,48109 49279,49297 
51613,51631 55313,55331 56179,56197 56713,56731 
58613,58631 63079,63097 63179,63197 64091,64109 
65479,65497 66413,66431 74779,74797 75913,75931 
76213,76231 76579,76597                         
   +/isorm i.&.(p:inv) 1e6   NB. number of Ormiston pairs less than 1e6
382
   +/isorm i.&.(p:inv) 1e7   NB. number of Ormiston pairs less than 1e7
3722

jq

Works with: jq

Preliminaries

# Input:  a positive integer
# Output: an array, $a, of length .+1 such that
#         $a[$i] is $i if $i is prime, and false otherwise.
def primeSieve:
  # erase(i) sets .[i*j] to false for integral j > 1
  def erase($i):
    if .[$i] then
      reduce (range(2*$i; length; $i)) as $j (.; .[$j] = false) 
    else .
    end;
  (. + 1) as $n
  | (($n|sqrt) / 2) as $s
  | [null, null, range(2; $n)]
  | reduce (2, 1 + (2 * range(1; $s))) as $i (.; erase($i)) ;

The Task

def digits: tostring | explode;

def ormiston_pairs($limit):
  ($limit | primeSieve | map(select(.))) as $primes
  | range(0; $primes|length-1) as $i
  | $primes[$i]   as $p1
  | $primes[$i+1] as $p2
  | select( ($p2|digits|sort) == ($p1|digits|sort) )
  | [$p1, $p2] ;

def task($limit):
  reduce ormiston_pairs($limit) as $pair (
    {count:0, orm30: [], counts: [], j: 1e5};
    if .count < 30 then .orm30 += [$pair] else . end
    | if $pair[0] >= .j
      then .counts += [.count]
      | .j *= 10
      else .
      end
    | .count += 1 )
  | .counts += [.count]
  | ("First 30 Ormiston pairs:", (.orm30 | map(tostring) | _nwise(3) | join(" "))),
    "",
    foreach range(0; .counts|length) as $i (.j = 1e5;
      .emit = "\(.counts[$i]) Ormiston pairs before \(.j)"
      | .j *= 10;
      select(.emit).emit) );

task(1e7) # ten million
Output:
First 30 Ormiston pairs:
[1913,1931] [18379,18397] [19013,19031]
[25013,25031] [34613,34631] [35617,35671]
[35879,35897] [36979,36997] [37379,37397]
[37813,37831] [40013,40031] [40213,40231]
[40639,40693] [45613,45631] [48091,48109]
[49279,49297] [51613,51631] [55313,55331]
[56179,56197] [56713,56731] [58613,58631]
[63079,63097] [63179,63197] [64091,64109]
[65479,65497] [66413,66431] [74779,74797]
[75913,75931] [76213,76231] [76579,76597]

40 Ormiston pairs before 100000
382 Ormiston pairs before 1000000
3722 Ormiston pairs before 10000000

Julia

Translation of: Python
using Primes

function testormistons(toshow = 30, lim = 1_000_000)
    pri = primes(lim)
    csort = [sort!(collect(string(i))) for i in pri]
    ormistons = [(pri[i - 1], pri[i]) for i in 2:lastindex(pri) if csort[i - 1] == csort[i]]
    println("First $toshow Ormiston pairs under $lim:")
    for (i, o) in enumerate(ormistons)
        i > toshow && break
        print("(", lpad(first(o), 6), lpad(last(o), 6), " )", i % 5 == 0 ? "\n" : "  ")
    end
    println("\n", length(ormistons), " is the count of Ormiston pairs up to one million.")
end

testormistons()
Output:
Same as Python example.

Nim

import std/[algorithm, bitops, math, strformat, strutils]

type Sieve = object
  data: seq[byte]

func `[]`(sieve: Sieve; idx: Positive): bool =
  ## Return value of element at index "idx".
  let idx = idx shr 1
  let iByte = idx shr 3
  let iBit = idx and 7
  result = sieve.data[iByte].testBit(iBit)

func `[]=`(sieve: var Sieve; idx: Positive; val: bool) =
  ## Set value of element at index "idx".
  let idx = idx shr 1
  let iByte = idx shr 3
  let iBit = idx and 7
  if val: sieve.data[iByte].setBit(iBit)
  else: sieve.data[iByte].clearBit(iBit)

func newSieve(lim: Positive): Sieve =
  ## Create a sieve with given maximal index.
  result.data = newSeq[byte]((lim + 16) shr 4)

func initPrimes(lim: Positive): seq[Natural] =
  ## Initialize the list of primes from 2 to "lim".
  var composite = newSieve(lim)
  composite[1] = true
  for n in countup(3, sqrt(lim.toFloat).int, 2):
    if not composite[n]:
      for k in countup(n * n, lim, 2 * n):
        composite[k] = true
  result.add 2
  for n in countup(3, lim, 2):
    if not composite[n]:
      result.add n

let primes = initPrimes(100_000_000)

func digits(n: Positive): seq[int] =
  ## Return the sorted list of digits of "n".
  var n = n.Natural
  while n != 0:
    result.add n mod 10
    n = n div 10
  result.sort()

echo "First 30 Ormiston pairs:"
var count = 0
var limit = 100_000
for i in 1..(primes.len - 2):
  let p1 = primes[i]
  let p2 = primes[i + 1]
  if p1.digits == p2.digits:
    inc count
    if count <= 30:
      stdout.write &"({p1:5}, {p2:5})"
      stdout.write if count mod 3 == 0: '\n' else: ' '
      if count == 30: echo()
    elif p1 >= limit:
      echo &"Number of Ormiston pairs below {insertSep($limit)}: {count - 1}"
      limit *= 10
      if limit == 100_000_000:
        break
Output:
First 30 Ormiston pairs:
( 1913,  1931) (18379, 18397) (19013, 19031)
(25013, 25031) (34613, 34631) (35617, 35671)
(35879, 35897) (36979, 36997) (37379, 37397)
(37813, 37831) (40013, 40031) (40213, 40231)
(40639, 40693) (45613, 45631) (48091, 48109)
(49279, 49297) (51613, 51631) (55313, 55331)
(56179, 56197) (56713, 56731) (58613, 58631)
(63079, 63097) (63179, 63197) (64091, 64109)
(65479, 65497) (66413, 66431) (74779, 74797)
(75913, 75931) (76213, 76231) (76579, 76597)

Number of Ormiston pairs below 100_000: 40
Number of Ormiston pairs below 1_000_000: 382
Number of Ormiston pairs below 10_000_000: 3722

Pascal

Free Pascal

//update the digits by adding difference.// Using MOD 18 = 0 and convert is faster.

program Ormiston;
{$IFDEF FPC}{$MODE DELPHI} {$OPTIMIZATION ON,ALL}{$ENDIF}
{$IFDEF WINDOWS}{$APPLICATION CONSOLE}{$ENDIF}

uses
  sysutils,strUtils;

//********* segmented sieve of erathostenes *********
{segmented sieve of Erathostenes using only odd numbers}
{using presieved sieve of small primes, to reduce the most time consuming}
const
  smlPrimes :array [0..10] of Byte = (2,3,5,7,11,13,17,19,23,29,31);
  maxPreSievePrimeNum = 8;
  maxPreSievePrime = 19;//smlPrimes[maxPreSievePrimeNum];
  cSieveSize = 2*16384;//<= High(Word)+1 // Level I Data Cache
type
  tSievePrim = record
                 svdeltaPrime:word;//diff between actual and new prime
                 svSivOfs:word;    //Offset in sieve
                 svSivNum:LongWord;//1 shl (1+16+32) = 5.6e14
               end;
  tpSievePrim = ^tSievePrim;

var
//sieved with primes 3..maxPreSievePrime.here about 255255 Byte
{$ALIGN 32}
  preSieve :array[0..3*5*7*11*13*17*19-1] of Byte;//must be > cSieveSize
{$ALIGN 32}
  Sieve :array[0..cSieveSize-1] of Byte;
{$ALIGN 32}
//prime = FoundPrimesOffset + 2*FoundPrimes[0..FoundPrimesCnt]
  FoundPrimes : array[0..12252] of Word;
{$ALIGN 32}
  sievePrimes : array[0..1077863] of tSievePrim;
  FoundPrimesOffset : Uint64;
  FoundPrimesCnt,
  FoundPrimesIdx,
  FoundPrimesTotal,
  SieveNum,
  SieveMaxIdx,
  preSieveOffset,
  LastInsertedSievePrime :NativeUInt;

procedure CopyPreSieveInSieve; forward;
procedure CollectPrimes; forward;
procedure sieveOneSieve; forward;
procedure Init0Sieve; forward;
procedure SieveOneBlock; forward;

procedure preSieveInit;
var
  i,pr,j,umf : NativeInt;
Begin
  fillchar(preSieve[0],SizeOf(preSieve),#1);
  i := 1;
  pr := 3;// starts with pr = 3
  umf := 1;
  repeat
    IF preSieve[i] =1 then
    Begin
      pr := 2*i+1;
      j := i;
      repeat
        preSieve[j] := 0;
        inc(j,pr);
      until j> High(preSieve);
      umf := umf*pr;
    end;
    inc(i);
  until (pr = maxPreSievePrime)OR(umf>High(preSieve)) ;
  preSieveOffset := 0;
end;

function InsertSievePrimes(PrimPos:NativeInt):NativeInt;
var
  j    :NativeUINt;
  i,pr : NativeUInt;
begin
  i := 0;
  //ignore first primes already sieved with
  if SieveNum = 0 then
    i := maxPreSievePrimeNum;
  pr :=0;
  j := Uint64(SieveNum)*cSieveSize*2-LastInsertedSievePrime;
  with sievePrimes[PrimPos] do
  Begin
    pr := FoundPrimes[i]*2+1;
    svdeltaPrime := pr+j;
    j := pr;
  end;
  inc(PrimPos);
  for i := i+1 to FoundPrimesCnt-1 do
  Begin
    IF PrimPos > High(sievePrimes) then
      BREAK;
    with sievePrimes[PrimPos] do
    Begin
      pr := FoundPrimes[i]*2+1;
      svdeltaPrime := (pr-j);
      j := pr;
    end;
    inc(PrimPos);
  end;
  LastInsertedSievePrime :=Uint64(SieveNum)*cSieveSize*2+pr;
  result := PrimPos;
end;

procedure CalcSievePrimOfs(lmt:NativeUint);
//lmt High(sievePrimes)
var
  i,pr : NativeUInt;
  sq : Uint64;
begin
  pr := 0;
  i := 0;
  repeat
    with sievePrimes[i] do
    Begin
      pr := pr+svdeltaPrime;
      IF sqr(pr)  < (cSieveSize*2) then
      Begin
        svSivNum := 0;
        svSivOfs := (pr*pr-1) DIV 2;
      end
      else
      Begin
        SieveMaxIdx := i;
        pr := pr-svdeltaPrime;
        BREAK;
      end;
    end;
    inc(i);
  until i > lmt;

  for i := i to lmt do
  begin
    with sievePrimes[i] do
    Begin
      pr := pr+svdeltaPrime;
      sq := sqr(pr);
      svSivNum := sq DIV (2*cSieveSize);
      svSivOfs := ( (sq - Uint64(svSivNum)*(2*cSieveSize))-1)DIV 2;
    end;
  end;
end;

procedure sievePrimesInit;
var
  i,j,pr,PrimPos:NativeInt;
Begin
  LastInsertedSievePrime := 0;
  preSieveOffset := 0;
  SieveNum :=0;
  CopyPreSieveInSieve;
  //normal sieving of first sieve
  i := 1; // start with 3
  repeat
    while Sieve[i] = 0 do
      inc(i);
    pr := 2*i+1;
    inc(i);
    j := ((pr*pr)-1) DIV 2;
    if j > High(Sieve) then
      BREAK;
    repeat
      Sieve[j] := 0;
      inc(j,pr);
    until j > High(Sieve);
  until false;

  CollectPrimes;
  PrimPos := InsertSievePrimes(0);
  LastInsertedSievePrime := FoundPrimes[PrimPos]*2+1;

  IF PrimPos < High(sievePrimes) then
  Begin
    Init0Sieve;
    sieveOneBlock;
    repeat
      sieveOneBlock;
      dec(SieveNum);
      PrimPos := InsertSievePrimes(PrimPos);
      inc(SieveNum);
   until PrimPos > High(sievePrimes);
  end;
  Init0Sieve;
end;

procedure Init0Sieve;
begin
  FoundPrimesTotal :=0;
  preSieveOffset := 0;
  SieveNum :=0;
  CalcSievePrimOfs(High(sievePrimes));
end;

procedure CopyPreSieveInSieve;
var
  lmt : NativeInt;
Begin
  lmt := preSieveOffset+cSieveSize;
  lmt := lmt-(High(preSieve)+1);
  IF lmt<= 0 then
  begin
    Move(preSieve[preSieveOffset],Sieve[0],cSieveSize);
    if lmt <> 0 then
      inc(preSieveOffset,cSieveSize)
    else
      preSieveOffset := 0;
  end
  else
  begin
    Move(preSieve[preSieveOffset],Sieve[0],cSieveSize-lmt);
    Move(preSieve[0],Sieve[cSieveSize-lmt],lmt);
    preSieveOffset := lmt
  end;
end;

procedure sieveOneSieve;
var
  sp:tpSievePrim;
  pSieve :pByte;
  i,j,pr,sn,dSievNum :NativeUint;
Begin
  pr := 0;
  sn := sieveNum;
  sp := @sievePrimes[0];
  pSieve := @Sieve[0];
  For i := SieveMaxIdx downto 0 do
    with sp^ do
    begin
      pr := pr+svdeltaPrime;
      IF svSivNum = sn then
      Begin
        j := svSivOfs;
        repeat
          pSieve[j] := 0;
          inc(j,pr);
        until j > High(Sieve);
        dSievNum := j DIV cSieveSize;
        svSivOfs := j-dSievNum*cSieveSize;
        svSivNum := sn+dSievNum;
      end;
      inc(sp);
    end;
  i := SieveMaxIdx+1;
  repeat
    if i > High(SievePrimes) then
      BREAK;
    with sp^ do
    begin
      if svSivNum > sn then
      Begin
        SieveMaxIdx := I-1;
        Break;
      end;
      pr := pr+svdeltaPrime;
      j := svSivOfs;
      repeat
        Sieve[j] := 0;
        inc(j,pr);
      until j > High(Sieve);
      dSievNum := j DIV cSieveSize;
      svSivOfs := j-dSievNum*cSieveSize;
      svSivNum := sn+dSievNum;
    end;
    inc(i);
    inc(sp);
  until false;
end;

procedure CollectPrimes;
//extract primes to FoundPrimes
var
   pSieve : pbyte;
   pFound : pWord;
   i,idx : NativeUint;
Begin
  FoundPrimesOffset := SieveNum*2*cSieveSize;
  FoundPrimesIdx := 0;
  pFound :=@FoundPrimes[0];
  i := 0;
  idx := 0;
  IF SieveNum = 0 then
  //include small primes used to pre-sieve
  Begin
    repeat
      pFound[idx]:= (smlPrimes[idx]-1) DIV 2;
      inc(idx);
    until smlPrimes[idx]>maxPreSievePrime;
    i := (smlPrimes[idx] -1) DIV 2;
  end;
  //grabbing the primes without if then -> reduces time extremly
  //primes are born to let branch-prediction fail.
  pSieve:= @Sieve[Low(Sieve)];
  repeat
    //store every value until a prime aka 1 is found
    pFound[idx]:= i;
    inc(idx,pSieve[i]);
    inc(i);
  until i>High(Sieve);
  FoundPrimesCnt:= idx;
  inc(FoundPrimesTotal,Idx);
end;

procedure SieveOneBlock;
begin
  CopyPreSieveInSieve;
  sieveOneSieve;
  CollectPrimes;
  inc(SieveNum);
end;

function Nextprime:Uint64;
Begin
  result := FoundPrimes[FoundPrimesIdx]*2+1+FoundPrimesOffset;
  if (FoundPrimesIdx=0) AND (sievenum = 1) then
    inc(result);
  inc(FoundPrimesIdx);
  If FoundPrimesIdx>= FoundPrimesCnt then
    SieveOneBlock;
end;

function PosOfPrime: Uint64;inline;
Begin
  result := FoundPrimesTotal-FoundPrimesCnt+FoundPrimesIdx;
end;

function TotalCount :Uint64;inline;
begin
  result := FoundPrimesTotal;
end;

function SieveSize :LongInt;inline;
Begin
  result := 2*cSieveSize;
end;

function SieveStart:Uint64;inline;
Begin
  result := (SieveNum-1)*2*cSieveSize;
end;

procedure InitPrime;
Begin
  Init0Sieve;
  SieveOneBlock;
end;
//********* segmented sieve of erathostenes *********

const
  Limit= 10*1000*1000*1000;
type
  tDigits10 = array[0..15] of byte;
  td10_UsedDgts2 = array[0..3] of  Uint32;
  td10_UsedDgts3 = array[0..1] of  Uint64;
  tpd10_UsedDgts3 = ^td10_UsedDgts3;

procedure OutIn(cnt,p1,p2:NativeInt);
Begin
  write('[',Numb2USA(IntToStr(p1)):6,'|',Numb2USA(IntToStr(p2)):6,']');
  if cnt MOD 5 = 0 then
     writeln;
end;

function OutByPot10(cnt,prLimit:NativeInt):NativeInt;
Begin
  writeln(Numb2USA(IntToStr(cnt)):12,' Ormiston pairs before ',Numb2USA(IntToStr(prLimit)):14);
  result := 10*prLimit;
end;

procedure Convert2Digits10(p:NativeUint;var outP:tDigits10);
var
  r : NativeUint;
begin
 // fillchar(outP,SizeOf(outP),#0);//takes longer
  td10_UsedDgts3(outP)[0]:=0;td10_UsedDgts3(outP)[1]:=0;
  repeat
    r := p DIV 10;
    inc(outP[p-10*r]);
    p := r;
  until r = 0;
end;

function CheckOrmiston(const d1,d2:tpd10_UsedDgts3):boolean;inline;
begin
  result := (d1^[0]=d2^[0]) AND (d1^[1]=d2^[1]);
end;

var
{$align 16}
  p1,p2 :tDigits10;
  pr,pr1,prLimit :nativeInt;
  cnt : NativeUint;
Begin
  preSieveInit;
  sievePrimesInit;
  InitPrime;

  prLimit := 100*1000;
  cnt := 0;
  pr1 := nextprime;
  repeat
    pr := nextprime;
    if pr > limit then
      BREAK;
    if (pr-pr1) mod 18 = 0  then
    begin
      Convert2Digits10(pr1,p1);
      Convert2Digits10(pr,p2);
      if CheckOrmiston(@p1,@p2) then
      begin
        inc(cnt);
        IF cnt <= 30 then
          OutIn(cnt,pr1,pr);
      end;
    end;
    if pr >=prLimit then
      prlimit:= OutByPot10(cnt,prlimit);
    pr1:= pr;
  until false;
  OutByPot10(cnt,prlimit);
end.
@TIO.RUN:
//only get all primes to 1E10 Real time: 13.294 s CPU share: 99.11 %
[ 1,913| 1,931][18,379|18,397][19,013|19,031][25,013|25,031][34,613|34,631]
[35,617|35,671][35,879|35,897][36,979|36,997][37,379|37,397][37,813|37,831]
[40,013|40,031][40,213|40,231][40,639|40,693][45,613|45,631][48,091|48,109]
[49,279|49,297][51,613|51,631][55,313|55,331][56,179|56,197][56,713|56,731]
[58,613|58,631][63,079|63,097][63,179|63,197][64,091|64,109][65,479|65,497]
[66,413|66,431][74,779|74,797][75,913|75,931][76,213|76,231][76,579|76,597]
          40 Ormiston pairs before        100,000
         382 Ormiston pairs before      1,000,000
       3,722 Ormiston pairs before     10,000,000
      34,901 Ormiston pairs before    100,000,000
     326,926 Ormiston pairs before  1,000,000,000
   3,037,903 Ormiston pairs before 10,000,000,000
Real time: 21.114 s User time: 20.862 s Sys. time: 0.057 s CPU share: 99.07 %
@home real	0m6,873s user	0m6,864s sys	0m0,008s

Perl

Library: ntheory
use strict;
use warnings;
use feature 'say';
use ntheory <primes vecfirstidx>;

my(@O,$pairs);
my @primes = @{ primes(1,1e8) };
my @A = map { join '', sort split '', $_ } @primes;
for (1..$#primes-1) { push @O, $_ if $A[$_] eq $A[$_+1] }

say "First 30 Ormiston pairs:";
$pairs .= sprintf "(%5d,%5d) ", $primes[$_], $primes[$_+1] for @O[0..29];
say $pairs =~ s/.{42}\K/\n/gr;

for (
  [1e5, 'one hundred thousand'],
  [1e6, 'one million'],
  [1e7, 'ten million']
) {
    my($limit,$text) = @$_;
    my $i = vecfirstidx { $primes[$_] >= $limit } @O;
    printf "%4d Ormiston pairs before %s\n", $i, $text;
}
Output:
First 30 Ormiston pairs:
( 1913, 1931) (18379,18397) (19013,19031)
(25013,25031) (34613,34631) (35617,35671)
(35879,35897) (36979,36997) (37379,37397)
(37813,37831) (40013,40031) (40213,40231)
(40639,40693) (45613,45631) (48091,48109)
(49279,49297) (51613,51631) (55313,55331)
(56179,56197) (56713,56731) (58613,58631)
(63079,63097) (63179,63197) (64091,64109)
(65479,65497) (66413,66431) (74779,74797)
(75913,75931) (76213,76231) (76579,76597)

  40 Ormiston pairs before one hundred thousand
 382 Ormiston pairs before one million
3722 Ormiston pairs before ten million

Phix

Translation of: Wren
with javascript_semantics
atom t0 = time(),
     t1 = time()+1
constant limit = iff(platform()=JS?1e8:1e9), -- (keep JS<10s)
        primes = get_primes_le(limit)
sequence orm30 = {}, counts = {}
integer count = 0, nc = 1e5
for i=1 to length(primes)-1 do
    integer p1 = primes[i],
            p2 = primes[i+1]
    if remainder(p2-p1,18)=0
    and sort(sprint(p1))=sort(sprint(p2)) then
        if count<30 then
            orm30 &= {sprintf("[%5d %5d]",{p1, p2})}
        end if  
        if p1>=nc then
            counts &= count
            nc *= 10
        end if
        count += 1
    end if
    if time()>t1 then
        progress("%d/%d\r",{i,length(primes)})
        t1 = time()+1
    end if
end for
progress("")
counts &= count
printf(1,"First 30 Ormiston pairs:\n%s\n",join_by(orm30,1,3))
for i,c in counts do
    printf(1,"%,d Ormiston pairs before %,d\n", {c, power(10,i+4)})
end for
?elapsed(time()-t0)
Output:
First 30 Ormiston pairs:
[ 1913  1931]   [18379 18397]   [19013 19031]
[25013 25031]   [34613 34631]   [35617 35671]
[35879 35897]   [36979 36997]   [37379 37397]
[37813 37831]   [40013 40031]   [40213 40231]
[40639 40693]   [45613 45631]   [48091 48109]
[49279 49297]   [51613 51631]   [55313 55331]
[56179 56197]   [56713 56731]   [58613 58631]
[63079 63097]   [63179 63197]   [64091 64109]
[65479 65497]   [66413 66431]   [74779 74797]
[75913 75931]   [76213 76231]   [76579 76597]

40 Ormiston pairs before 100,000
382 Ormiston pairs before 1,000,000
3,722 Ormiston pairs before 10,000,000
34,901 Ormiston pairs before 100,000,000
326,926 Ormiston pairs before 1,000,000,000
"39.8s"

slower but higher limits

--
-- demo\rosetta\Ormiston_pairs.exw
-- ===============================
--
--  Uses a segmented sieve, which is about half the speed of get_primes_le(), but uses far less memory
--  If permited, get_primes_le(1e10) would generate a result of 455,052,511 primes, more than 32 bit 
--  can cope with, and use over 6GB of ram, and take about 11mins 44s, that is on this box at least, 
--  whereas this processes them on-the-fly, and only uses about 6MB of memory (ie 0.1% of 6GB).
--
with javascript_semantics

atom t0 = time()

procedure ormiston_pairs(atom limit)
    // Generate primes using the segmented sieve of Eratosthenes.
    // credit: https://gist.github.com/kimwalisch/3dc39786fab8d5b34fee
    integer segment_size = floor(sqrt(limit)),
            count = 0, i = 3, s = 3
    atom p1 = 2, n = 3, nc = 1e5, low = 0, t1 = time()+1

    sequence isprime = repeat(true,segment_size+1),
             primes = {},
             multiples = {},
             orm30 = repeat(0,30)

    while low<=limit do
        sequence sieve = repeat(true,segment_size+1)
        if time()>t1 then
            progress("Processing %,d/%,d (%3.2f%%)\r",{low,limit,(low/limit)*100})
            t1 = time()+1
        end if

        // current segment = [low, high]
        atom high = min(low+segment_size,limit)
        // generate sieving primes using simple sieve of Eratosthenes
        while i*i<=min(high,segment_size) do
            if isprime[i+1] then
                for j=i*i to segment_size by i do
                    isprime[j+1] = false
                end for
            end if
            i += 2
        end while
    
        // initialize sieving primes for segmented sieve
        while s*s<=high do
            if isprime[s+1] then
                   primes &= s
                multiples &= s*s-low
            end if
            s += 2
        end while

        // sieve the current segment
        for mi,j in multiples do
            integer k = primes[mi]*2
            while j<segment_size do
                sieve[j+1] = false
                j += k
            end while
            multiples[mi] = j - segment_size
        end for

        while n<=high do
            if sieve[n-low+1] then // n is a prime
                if remainder(n-p1,18)=0
                and sort(sprint(p1))=sort(sprint(n)) then
                    if p1>=nc then
                        string e = elapsed_short(time()-t0)
                        progress("%,d Ormiston pairs before %,d (%s)\n", {count, nc, e})
                        nc *= 10
                    end if
                    count += 1
                    if count<=30 then
                        orm30[count] = sprintf("[%5d %5d]",{p1, n})
                        if count=30 then
                            printf(1,"First 30 Ormiston pairs:\n%s\n",join_by(orm30,1,3))
                        end if  
                    end if  
                end if
                p1 = n
            end if
            n += 2
        end while
        low += segment_size
    end while
    string e = elapsed_short(time()-t0)
    progress("%,d Ormiston pairs before %,d (%s)\n", {count, nc, e})
end procedure
ormiston_pairs(iff(platform()=JS?1e8:1e9))
Output:

With limit upped to 1e10

First 30 Ormiston pairs:
[ 1913  1931]   [18379 18397]   [19013 19031]
[25013 25031]   [34613 34631]   [35617 35671]
[35879 35897]   [36979 36997]   [37379 37397]
[37813 37831]   [40013 40031]   [40213 40231]
[40639 40693]   [45613 45631]   [48091 48109]
[49279 49297]   [51613 51631]   [55313 55331]
[56179 56197]   [56713 56731]   [58613 58631]
[63079 63097]   [63179 63197]   [64091 64109]
[65479 65497]   [66413 66431]   [74779 74797]
[75913 75931]   [76213 76231]   [76579 76597]

40 Ormiston pairs before 100,000 (0s)
382 Ormiston pairs before 1,000,000 (0s)
3,722 Ormiston pairs before 10,000,000 (0s)
34,901 Ormiston pairs before 100,000,000 (5s)
326,926 Ormiston pairs before 1,000,000,000 (55s)
3,037,903 Ormiston pairs before 10,000,000,000 (21:57)

Note that running this under pwa/p2js with a limit of 1e9 would get you a blank screen for 1min 25s, hence I've limited it to 1e8 (8s)
I have not the patience to see whether JavaScript would actually cope with 1e10, but it should (with a blank screen for at least half an hour).

Python

""" rosettacode.org task Ormiston_pairs """

from sympy import primerange


PRIMES1M = list(primerange(1, 1_000_000))
ASBASE10SORT = [str(sorted(list(str(i)))) for i in PRIMES1M]
ORMISTONS = [(PRIMES1M[i - 1], PRIMES1M[i]) for i in range(1, len(PRIMES1M))
             if ASBASE10SORT[i - 1] == ASBASE10SORT[i]]

print('First 30 Ormiston pairs:')
for (i, o) in enumerate(ORMISTONS):
    if i < 30:
        print(f'({o[0] : 6} {o[1] : 6} )',
              end='\n' if (i + 1) % 5 == 0 else '  ')
    else:
        break

print(len(ORMISTONS), 'is the count of Ormiston pairs up to one million.')
Output:
First 30 Ormiston pairs:
(  1913   1931 )  ( 18379  18397 )  ( 19013  19031 )  ( 25013  25031 )  ( 34613  34631 )
( 35617  35671 )  ( 35879  35897 )  ( 36979  36997 )  ( 37379  37397 )  ( 37813  37831 )
( 40013  40031 )  ( 40213  40231 )  ( 40639  40693 )  ( 45613  45631 )  ( 48091  48109 )
( 49279  49297 )  ( 51613  51631 )  ( 55313  55331 )  ( 56179  56197 )  ( 56713  56731 )
( 58613  58631 )  ( 63079  63097 )  ( 63179  63197 )  ( 64091  64109 )  ( 65479  65497 )
( 66413  66431 )  ( 74779  74797 )  ( 75913  75931 )  ( 76213  76231 )  ( 76579  76597 )
382 is the count of Ormiston pairs up to one million.

Raku

use Lingua::EN::Numbers;
use List::Divvy;

my @primes = lazy (^∞).hyper.grep( &is-prime ).map: { $_ => .comb.sort.join };
my @Ormistons = @primes.kv.map: { ($^value.key, @primes[$^key+1].key) if $^value.value eq @primes[$^key+1].value };

say "First thirty Ormiston pairs:"; 
say @Ormistons[^30].batch(3)».map( { "({.[0].fmt: "%5d"}, {.[1].fmt: "%5d"})" } ).join: "\n";
say '';
say +@Ormistons.&before( *[1] > $_ ) ~ " Ormiston pairs before " ~ .Int.&cardinal for 1e5, 1e6, 1e7;
Output:
First thirty Ormiston pairs:
( 1913,  1931) (18379, 18397) (19013, 19031)
(25013, 25031) (34613, 34631) (35617, 35671)
(35879, 35897) (36979, 36997) (37379, 37397)
(37813, 37831) (40013, 40031) (40213, 40231)
(40639, 40693) (45613, 45631) (48091, 48109)
(49279, 49297) (51613, 51631) (55313, 55331)
(56179, 56197) (56713, 56731) (58613, 58631)
(63079, 63097) (63179, 63197) (64091, 64109)
(65479, 65497) (66413, 66431) (74779, 74797)
(75913, 75931) (76213, 76231) (76579, 76597)

40 Ormiston pairs before one hundred thousand
382 Ormiston pairs before one million
3722 Ormiston pairs before ten million

Ring

see "working..." + nl
see "First 30 Ormiston pairs:" + nl
limit = 1000000
Primes = []
Primes1 = []
Primes2 = []

add(Primes,2)
pr = 1
while true
    pr = pr + 2
    if isPrime(pr) and pr < limit
       add(Primes,pr)
    ok
    if pr > limit
       exit
    ok
end

n = 0
row = 0

for n = 1 to len(Primes) - 1
    Primes1 = []
    Primes2 = []
    str1 = string(Primes[n])
    str2 = string(Primes[n+1])
    for p = 1 to len(str1)
        add(Primes1,substr(str1,p,1))
    next
    for p = 1 to len(str2)
        add(Primes2,substr(str2,p,1))
    next
    Sort1 = sort(Primes1)
    Sort2 = sort(Primes2)

    flag = 1
    if len(Sort1) = len(Sort2)
       for p = 1 to len(Sort1)
           if Sort1[p] != Sort2[p]
              flag = 0 
              exit
           ok
       next
       if flag = 1
          row++
          if row < 31
             str1m = str1
             str2m = str2
             see "(" + str1 + ", " + str2 + ")  "
             if row % 3 = 0
                see nl
             ok
          ok
       ok
    ok
end
see nl + "Number of pairs < 1,000,000: " + row + nl
see "done..." + 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
Output:
working...
First 30 Ormiston pairs:
 ( 1913,  1931)  (18379, 18397)  (19013, 19031)
 (25013, 25031)  (34613, 34631)  (35617, 35671)
 (35879, 35897)  (36979, 36997)  (37379, 37397)
 (37813, 37831)  (40013, 40031)  (40213, 40231)
 (40639, 40693)  (45613, 45631)  (48091, 48109)
 (49279, 49297)  (51613, 51631)  (55313, 55331)
 (56179, 56197)  (56713, 56731)  (58613, 58631)
 (63079, 63097)  (63179, 63197)  (64091, 64109)
 (65479, 65497)  (66413, 66431)  (74779, 74797)
 (75913, 75931)  (76213, 76231)  (76579, 76597)
Number of pairs < 1,000,000: 382
done...


RPL

Works with: HP version 49
« →STR { 10 } 0 CON
  1 PICK3 SIZE FOR j
     OVER j DUP SUB STR→ 1 +
     DUP2 GET 1 + PUT
  NEXT NIP
» 'DIGCNT' STO     @ ( n → [ count0 .. count9 ] ) 

« 0 { } 2 3
  WHILE DUP 1E6 < REPEAT
     IF DUP2 DIGCNT SWAP DIGCNT == THEN 
        IF PICK3 SIZE 30 < THEN 
           DUP2 2 →LIST 1 →LIST 4 ROLL SWAP + UNROT 
        END
        4 ROLL 1 + 4 ROLLD
     END
     NIP DUP NEXTPRIME
  END DROP2 SWAP
» 'TASK' STO
Output:
2: {{1913 1931} {18379 18397} {19013 19031} {25013 25031} {34613 34631} {35617 35671} {35879 35897} {36979 36997} {37379 37397} {37813 37831} {40013 40031} {40213 40231} {40639 40693} {45613 45631} {48091 48109} {49279 49297} {51613 51631} {55313 55331} {56179 56197} {56713 56731} {58613 58631} {63079 63097} {63179 63197} {64091 64109} {65479 65497} {66413 66431} {74779 74797} {75913 75931} {76213 76231} {76579 76597}}
1: 382

Rust

// [dependencies]
// primal = "0.3"

fn get_digits(mut n: usize) -> [usize; 10] {
    let mut digits = [0; 10];
    while n > 0 {
        digits[n % 10] += 1;
        n /= 10;
    }
    digits
}

fn ormiston_pairs() -> impl std::iter::Iterator<Item = (usize, usize)> {
    let mut digits = [0; 10];
    let mut prime = 0;
    let mut primes = primal::Primes::all();
    std::iter::from_fn(move || {
        for p in primes.by_ref() {
            let prime0 = prime;
            prime = p;
            let digits0 = digits;
            digits = get_digits(prime);
            if digits == digits0 {
                return Some((prime0, prime));
            }
        }
        None
    })
}

fn main() {
    let mut count = 0;
    let mut op = ormiston_pairs();
    println!("First 30 Ormiston pairs:");
    for (p1, p2) in op.by_ref() {
        count += 1;
        let c = if count % 3 == 0 { '\n' } else { ' ' };
        print!("({:5}, {:5}){}", p1, p2, c);
        if count == 30 {
            break;
        }
    }
    println!();
    let mut limit = 1000000;
    for (p1, _) in op.by_ref() {
        if p1 > limit {
            println!("Number of Ormiston pairs < {}: {}", limit, count);
            limit *= 10;
            if limit == 10000000000 {
                break;
            }
        }
        count += 1;
    }
}
Output:
First 30 Ormiston pairs:
( 1913,  1931) (18379, 18397) (19013, 19031)
(25013, 25031) (34613, 34631) (35617, 35671)
(35879, 35897) (36979, 36997) (37379, 37397)
(37813, 37831) (40013, 40031) (40213, 40231)
(40639, 40693) (45613, 45631) (48091, 48109)
(49279, 49297) (51613, 51631) (55313, 55331)
(56179, 56197) (56713, 56731) (58613, 58631)
(63079, 63097) (63179, 63197) (64091, 64109)
(65479, 65497) (66413, 66431) (74779, 74797)
(75913, 75931) (76213, 76231) (76579, 76597)

Number of Ormiston pairs < 1000000: 382
Number of Ormiston pairs < 10000000: 3722
Number of Ormiston pairs < 100000000: 34901
Number of Ormiston pairs < 1000000000: 326926

Wren

Library: Wren-math
Library: Wren-fmt
import "./math" for Int
import "./fmt" for Fmt

var limit = 1e9
var primes = Int.primeSieve(limit)
var orm30 = []
var j = 1e5
var count = 0
var counts = []
for (i in 0...primes.count-1) {
    var p1 = primes[i]
    var p2 = primes[i+1]
    if ((p2 - p1) % 18 != 0) continue
    var key1 = 1
    for (dig in Int.digits(p1)) key1 = key1 * primes[dig]
    var key2 = 1
    for (dig in Int.digits(p2)) key2 = key2 * primes[dig]
    if (key1 == key2) {
        if (count < 30) orm30.add([p1, p2])
        if (p1 >= j) {
            counts.add(count)
            j = j * 10
        }
        count = count + 1
    }
}
counts.add(count)
System.print("First 30 Ormiston pairs:")
Fmt.tprint("[$,6d] ", orm30, 3)
System.print()
j = 1e5
for (i in 0...counts.count) {
    Fmt.print("$,d Ormiston pairs before $,d",  counts[i], j)
    j = j * 10
}
Output:
First 30 Ormiston pairs:
[ 1,913  1,931]  [18,379 18,397]  [19,013 19,031]  
[25,013 25,031]  [34,613 34,631]  [35,617 35,671]  
[35,879 35,897]  [36,979 36,997]  [37,379 37,397]  
[37,813 37,831]  [40,013 40,031]  [40,213 40,231]  
[40,639 40,693]  [45,613 45,631]  [48,091 48,109]  
[49,279 49,297]  [51,613 51,631]  [55,313 55,331]  
[56,179 56,197]  [56,713 56,731]  [58,613 58,631]  
[63,079 63,097]  [63,179 63,197]  [64,091 64,109]  
[65,479 65,497]  [66,413 66,431]  [74,779 74,797]  
[75,913 75,931]  [76,213 76,231]  [76,579 76,597]  

40 Ormiston pairs before 100,000
382 Ormiston pairs before 1,000,000
3,722 Ormiston pairs before 10,000,000
34,901 Ormiston pairs before 100,000,000
326,926 Ormiston pairs before 1,000,000,000

XPL0

func IsPrime(N);        \Return 'true' if N is prime
int  N, I;
[if N <= 2 then return N = 2;
if (N&1) = 0 then \even >2\ return false;
for I:= 3 to sqrt(N) do
    [if rem(N/I) = 0 then return false;
    I:= I+1;
    ];
return true;
];

func GetSig(N);         \Return signature of N
\A "signature" is the count of each digit in N packed into a 32-bit word
int N, Sig;
[Sig:= 0;
repeat  N:= N/10;
        Sig:= Sig + 1<<(rem(0)*3);
until   N = 0;
return Sig;
];

int Cnt, N, N0, Sig, Sig0;
[Cnt:= 0;  N0:= 0;  Sig0:= 0;  N:= 3;
Format(6, 0);
loop    [if IsPrime(N) then
            [Sig:= GetSig(N);
            if Sig = Sig0 then
                [Cnt:= Cnt+1;
                if Cnt <= 30 then
                    [RlOut(0, float(N0));  RlOut(0, float(N));
                    if rem(Cnt/3) = 0 then CrLf(0) else Text(0, "  ");
                    ];
                ];
            Sig0:= Sig;
            N0:= N;
            ];
        if N = 1_000_000-1 then
            [Text(0, "^m^jOrmiston pairs up to one million: ");
            IntOut(0, Cnt);
            ];
        if N = 10_000_000-1 then
            [Text(0, "^m^jOrmiston pairs up to ten million: ");
            IntOut(0, Cnt);
            quit;
            ];
        N:= N+2;
        ];
]
Output:
  1913  1931   18379 18397   19013 19031
 25013 25031   34613 34631   35617 35671
 35879 35897   36979 36997   37379 37397
 37813 37831   40013 40031   40213 40231
 40639 40693   45613 45631   48091 48109
 49279 49297   51613 51631   55313 55331
 56179 56197   56713 56731   58613 58631
 63079 63097   63179 63197   64091 64109
 65479 65497   66413 66431   74779 74797
 75913 75931   76213 76231   76579 76597

Ormiston pairs up to one million: 382
Ormiston pairs up to ten million: 3722