An   emirp   (prime spelled backwards)   are primes that when reversed   (in their decimal representation)   are a different prime.

(This rules out palindromic primes.)



Task

   show the first   twenty   emirps
   show all emirps between   7,700   and   8,000
   show the   10,000th   emirp


In each list, the numbers should be in order.

Invoke the (same) program once per task requirement, this will show what limit is used as the upper bound for calculating surplus (regular) primes.

The specific method of how to determine if a range or if specific values are to be shown will be left to the programmer.



See also

   Wikipedia, Emirp.
   The Prime Pages, emirp.
   Wolfram MathWorld™, Emirp.
   The On‑Line Encyclopedia of Integer Sequences, emirps (A6567).


program Emirp;
//palindrome prime 13 <-> 31
{$IFDEF FPC}
  {$MODE DELPHI}
  {$OPTIMIZATION ON}
  {$OPTIMIZATION REGVAR}
  {$OPTIMIZATION PEEPHOLE}
  {$OPTIMIZATION CSE}
  {$OPTIMIZATION ASMCSE}
  {$Smartlink ON}
  {$CODEALIGN proc=32}
{$ELSE}
  {$APPLICATION CONSOLE}
{$ENDIF}
uses
  primtrial,sysutils; //IntToStr
const
  helptext : array[0..5] of string =
     ('  usage ',
      '  t     -> test of functions',
      '  b l u -> Emirps betwenn l,u       b 7700 8000',
      '  c n   -> count of Emirps up to n  c 99999',
      '  f n   -> output n first Emirp     f 20',
      '  n     -> output the n.th Emirps   10000');
 
  StepToNextPrimeEnd : Array[0..9] of byte =
              (1,0,3,0,7,7,7,0,9,0);
 
  base = 10;
 
var
  s: AnsiString;
  pow,
  powLen  : NativeUint;
 
procedure OutputHelp;
var
  i : NativeUint;
Begin
  For i := Low(helptext) to High(helptext) do
    writeln(helptext[i]);
  writeln;
end;
 
function GetNumber(const s: string;var n:NativeUint):boolean;
var
  ErrCode: Word;
Begin
  val(s,n,Errcode);
  result := ErrCode = 0;
end;
 
procedure RvsStr(var s: AnsiString);
var
  i, j: NativeUint;
  swapChar : Ansichar;
Begin
  i := 1;
  j := Length(s);
  While j>i do Begin
    swapChar:= s[i];s[i] := s[j];s[j] := swapChar;
    inc(i);dec(j) end;
end;
 
function RvsNumL(var n: NativeUint):NativeUint;
//reverse and last digit
var
  q, c: NativeUint;
Begin
  result := n;
  q := 0;
  repeat
    c:= result div Base;
    q := q*Base+(result-c*Base);
    result := c;
  until result < Base;
  n := q*Base+result;
 
end;
 
procedure InitP(var p: NativeUint);
Begin
  powLen := 2;
  pow := Base;
  InitPrime;
  repeat p :=NextPrime until p >= 11;
end;
 
function isEmirp(p: NativeUint):boolean;
var
  rvsp: NativeUint;
Begin
  s := IntToStr(p);
  result := StepToNextPrimeEnd[Ord(s[1])-48] = 0;
  IF result then
  Begin
    RvsStr(s);
    rvsp := StrToInt(s);
    result := false;
    IF rvsp<>p then
      result := isPrime(rvsp);
  end;
end;
 
function NextEmirp:NativeUint;
var
 r,Ldgt: NativeUint;
Begin
  result:= NextPrime;
  repeat
    r := result;
    //reverse
    Ldgt := RvsNumL(r);
    Ldgt := StepToNextPrimeEnd[Ldgt];
    IF Ldgt = 0 then
    Begin
      IF r<>result then
        IF isPrime(r) then
          EXIT;
      result:= NextPrime;
    end
    else
    Begin
      while actPrime > pow*Base do
      Begin
        inc(PowLen);
        pow := pow*base;
      end;
      result := Ldgt*pow;
      result := PrimeGELimit(result);
    end;
  until false;
end;
 
function GetIthEmirp(i: NativeUint):NativeUint;
var
  p : NativeUint;
Begin
  InitP(p);
  Repeat
    dec(i);
    p:= NextEmirp;
  until i = 0;
  result := p;
end;
 
procedure nFirstEmirp(n: NativeUint);
var
  p : NativeUint;
 
Begin
  InitP(p);
  Writeln('the first ',n,' Emirp primE: ');
  Repeat
    dec(n);
    p:= NextEmirp;
    write(p,' ');
  until n = 0;
  Writeln;
end;
 
function CntToLimit(n: NativeUint):NativeUint;
var
  p,cnt : NativeUint;
Begin
  cnt := 0;
  InitP(p);
  p:= NextEmirp;
  While p <= n do
  Begin
    inc(cnt);
    p:= NextEmirp;
  end;
  result := cnt;
end;
 
procedure InRange(l,u:NativeUint);
var
  p : NativeUint;
  b : boolean;
Begin
  InitP(p);
  IF l > u then Begin p:=l;l:=u;u:=p end;
  Writeln('Emirp primes between ',l,' and ',u,' : ');
  p := PrimeGELimit(l);
 
  b := IsEmirp(p);
  if b then
    write(p,' ');
  p:= NextEmirp;
  IF (p> u) AND NOT b  then
    Writeln('none')
  else
  Begin
    while p < u do
      Begin
      write(p,' ');
      p:= NextEmirp;
    end;
    Writeln;
  end;
end;
 
var
  i,u: NativeUint;
  select : char;
Begin
  IF paramcount >= 1 then
    select := Lowercase(paramstr(1)[1]);
  case paramcount of
  1: Begin
       if select='t' then
       Begin
         nFirstEmirp(20);
         InRange(7700,8000);
         Writeln('the ',10000,'.th Emirp prime: ',GetIthEmirp(10000));
         writeln(CntToLimit(9999),' Emirp primes up to ',9999);
         // as a gag
         InRange(400000000,700000000);
       end
       else
         IF GetNumber(paramstr(1),i) then
           Writeln('the ',i,'.th Emirp prime: ',GetIthEmirp(i))
         else
           OutPutHelp;
     end;
  2: Begin
       case select of
       'c': If GetNumber(paramstr(2),i) then
              writeln(CntToLimit(i),' Eemirp primes up to ',i)
            else
              OutPutHelp;
       'f': If GetNumber(paramstr(2),i) then
              nFirstEmirp(i)
            else
              OutPutHelp;
        else
          OutPutHelp;
        end;
     end;
  3: IF (select ='b') AND
        GetNumber(paramstr(2),i) AND GetNumber(paramstr(3),u) Then
       InRange(i,u)
     else
        OutPutHelp;
  else
    OutPutHelp;
  end;
End.