Multi-base primes: Difference between revisions

Content added Content deleted
m (→‎{{header|Pascal}}: Forget to inc number in IncInBaseDigits and to reset all digits to 0 in CnvtoBASE)
Line 644: Line 644:
{$MODE DELPHI}
{$MODE DELPHI}
{$OPTIMIZATION ON,ALL}
{$OPTIMIZATION ON,ALL}
// {$R+,O+}
{$ELSE}
{$ELSE}
{$APPTYPE CONSOLE}
{$APPTYPE CONSOLE}
Line 653: Line 652:
CharOfBase= '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
CharOfBase= '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
MINBASE = 2;
MINBASE = 2;
MAXBASE = 62;//62;//36
MAXBASE = 62;//36;//62;
MAXDIGITCOUNT = 5;//6;
MAXDIGITCOUNT = 5;//6;
type
type
tdigits = record
tdigits = packed record
dgtDgts : array [0..13] of byte;
dgtDgts : array [0..13] of byte;
dgtMaxIdx,
dgtMaxIdx,
Line 665: Line 664:
var
var
BoolPrimes: array of boolean;
BoolPrimes: array of boolean;

function Out_String(n:Uint64;var s: AnsiString):Uint32;forward;

procedure Out_Digits(const dgts:tDigits);
var
s : ANsistring;
i : Int32;
begin
s := '';
with dgts do
Begin
i := dgtMaxIdx;
while i >= 0 do
begin
s := s+CharOfBase[dgtDgts[i]];
dec(i);
end;
end;
write(#13,s);
end;


function BuildWheel(primeLimit:Int64):NativeUint;
function BuildWheel(primeLimit:Int64):NativeUint;
Line 772: Line 751:
end;
end;


procedure CnvtoMAXBASE(n:Uint64;var dgt:tDigits);
procedure CnvtoBASE(var dgt:tDigits;n:Uint64;base:NativeUint);
var
var
q,r: Uint64;
q,r: Uint64;
Line 780: Line 759:
with dgt do
with dgt do
Begin
Begin
fillchar(dgtDgts,SizeOf(dgtDgts),#0);
dgtNum:= n;
dgtNum:= n;
repeat
repeat
r := n;
r := n;
q := n div MAXBASE;
q := n div base;
r -= q*MAXBASE;
r -= q*base;
n := q;
n := q;
dgtDgts[i] := r;
dgtDgts[i] := r;
Line 803: Line 783:
end;
end;


function CnvtoBase(const dgt:tDigits;base:NativeUint):Uint64;
function CnvDgtAsInBase(const dgt:tDigits;base:NativeUint):Uint64;
var
var
tmpDgt,i: NativeInt;
tmpDgt,i: NativeInt;
Line 812: Line 792:
i:= dgtMaxIdx;
i:= dgtMaxIdx;
repeat
repeat
//result := base*result + dgtDgts[i];
//this is th reason for speed up.Hide the waiting for reading of dgtDgts[i]
tmpDgt := dgtDgts[i];
tmpDgt := dgtDgts[i];
result *= base;
result *= base;
Line 822: Line 800:
end;
end;


procedure IncMAXBASEDigits(var dgt:tDigits);
procedure IncInBaseDigits(var dgt:tDigits;base:NativeInt);
var
var
i,q,tmp :NativeInt;
i,q,tmp :NativeInt;
Line 828: Line 806:
with dgt do
with dgt do
Begin
Begin
tmp := dgtMaxIdx;
tmp := dgtMaxIdx;
i := 0;
i := 0;
repeat
repeat
q := dgtDgts[i]+1;
q := dgtDgts[i]+1;
q -= (-ORD(q >=MAXBASE) AND MAXBASE);
q -= (-ORD(q >=base) AND base);
dgtDgts[i] := q;
dgtDgts[i] := q;
inc(i);
inc(i);
Line 842: Line 820:
dgtMaxIdx := i;
dgtMaxIdx := i;
end;
end;

i := tmp;
i := tmp;
repeat
repeat
Line 850: Line 827:
dec(i);
dec(i);
until i <0;
until i <0;
inc(dgtNum);
dgtMaxDgtVal := q;
dgtMaxDgtVal := q;
end;
end;
Line 860: Line 838:
begin
begin
result := 0;
result := 0;
IncMAXBASEDigits(Digits);
IncInBaseDigits(Digits,MAXBASE);
Base := Digits.dgtMaxDgtVal+1;
base := Digits.dgtMaxDgtVal+1;
//divisible by every base
//divisible by every base
IF Digits.dgtDgts[0] = 0 then
IF Digits.dgtDgts[0] = 0 then
EXIT;
EXIT;
IF base < MINBASE then base := MINBASE;
// if (MAXBASE - Base) <= (max-result) then BREAK;
// if (MAXBASE - Base) <= (max-result) then BREAK;
max := (max+Base-MAXBASE);
max := (max+Base-MAXBASE);
Line 871: Line 850:
for base := base TO MAXBASE do
for base := base TO MAXBASE do
begin
begin
pr := CnvtoBase(Digits,base);
pr := CnvDgtAsInBase(Digits,base);
inc(result,Ord(boolprimes[pr]));
inc(result,Ord(boolprimes[pr]));
//no chance to reach max then exit
//no chance to reach max then exit
Line 917: Line 896:
var
var
dgt:tDigits;
dgt:tDigits;
sl : string[8];
sl : string[15];
base,i: Int32;
base,i: Int32;
Begin
Begin
result := 0;
result := 0;
CnvtoMAXBASE(n,dgt);
CnvtoBASE(dgt,n,MaxBase);
sl := '';
sl := '';
with dgt do
with dgt do
begin
begin
base:= dgtMaxDgtVal+1;
base:= dgtMaxDgtVal+1;
IF base < MINBASE then
base := MINBASE;
i := dgtMaxIdx;
i := dgtMaxIdx;
while (i>=0)do
while (i>=0)do
Line 935: Line 916:
end;
end;
For base := base to MAXBASE do
For base := base to MAXBASE do
if boolprimes[CnvtoBase(dgt,base)] then
if boolprimes[CnvDgtAsInBase(dgt,base)] then
begin
begin
inc(result);
inc(result);
Line 966: Line 947:
T0 : Int64;
T0 : Int64;
i : NativeInt;
i : NativeInt;
lmt,minLmt : UInt32;
lmt,minLmt : UInt64;

begin
begin
T0 := GetTickCount64;
T0 := GetTickCount64;
Line 977: Line 957:
Sieve(lmt);
Sieve(lmt);
writeln('Prime sieving ',(GetTickCount64-T0)/1000:6:3,' s');
writeln('Prime sieving ',(GetTickCount64-T0)/1000:6:3,' s');

CnvtoMAXBASE(0,dgt);
T0 := GetTickCount64;
T0 := GetTickCount64;
CnvtoBASE(dgt,0,MAXBASE);
i := 1;
i := 1;
minLmt := 1;
minLmt := 1;
Retrieved from "https://rosettacode.org/wiki/Multi-base_primes"