Data commit

Task/Emirp-primes/Pascal/emirp-primes.pas

@@ -0,0 +1,249 @@
+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.