Initial data commit
This commit is contained in:
Ingy döt Net
parent
72d218235f
commit
f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
331
Task/Multi-base-primes/Pascal/multi-base-primes.pas
Normal file
331
Task/Multi-base-primes/Pascal/multi-base-primes.pas
Normal file
|
|
@ -0,0 +1,331 @@
|
|||
program MAXBaseStringIsPrimeInBase;
|
||||
{$IFDEF FPC}
|
||||
{$MODE DELPHI}
|
||||
{$OPTIMIZATION ON,ALL}
|
||||
{$ELSE}
|
||||
{$APPTYPE CONSOLE}
|
||||
{$ENDIF}
|
||||
uses
|
||||
sysutils;
|
||||
const
|
||||
CharOfBase= '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
|
||||
MINBASE = 2;
|
||||
MAXBASE = 62;//36;//62;
|
||||
MAXDIGITCOUNT = 5;//6;
|
||||
type
|
||||
tdigits = packed record
|
||||
dgtDgts : array [0..13] of byte;
|
||||
dgtMaxIdx,
|
||||
dgtMaxDgtVal :byte;
|
||||
dgtNum : Uint64;
|
||||
end;
|
||||
tSol = array of Uint64;
|
||||
var
|
||||
BoolPrimes: array of boolean;
|
||||
|
||||
function BuildWheel(primeLimit:Int64):NativeUint;
|
||||
var
|
||||
myPrimes : pBoolean;
|
||||
wheelprimes :array[0..31] of byte;
|
||||
wheelSize,wpno,
|
||||
pr,pw,i, k: NativeUint;
|
||||
begin
|
||||
myPrimes := @BoolPrimes[0];
|
||||
pr := 1;
|
||||
myPrimes[1]:= true;
|
||||
WheelSize := 1;
|
||||
wpno := 0;
|
||||
repeat
|
||||
inc(pr);
|
||||
pw := pr;
|
||||
if pw > wheelsize then
|
||||
dec(pw,wheelsize);
|
||||
If myPrimes[pw] then
|
||||
begin
|
||||
k := WheelSize+1;
|
||||
for i := 1 to pr-1 do
|
||||
begin
|
||||
inc(k,WheelSize);
|
||||
if k<primeLimit then
|
||||
move(myPrimes[1],myPrimes[k-WheelSize],WheelSize)
|
||||
else
|
||||
begin
|
||||
move(myPrimes[1],myPrimes[k-WheelSize],PrimeLimit-WheelSize*i);
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
dec(k);
|
||||
IF k > primeLimit then
|
||||
k := primeLimit;
|
||||
wheelPrimes[wpno] := pr;
|
||||
myPrimes[pr] := false;
|
||||
inc(wpno);
|
||||
WheelSize := k;
|
||||
i:= pr;
|
||||
i := i*i;
|
||||
while i <= k do
|
||||
begin
|
||||
myPrimes[i] := false;
|
||||
inc(i,pr);
|
||||
end;
|
||||
end;
|
||||
until WheelSize >= PrimeLimit;
|
||||
|
||||
while wpno > 0 do
|
||||
begin
|
||||
dec(wpno);
|
||||
myPrimes[wheelPrimes[wpno]] := true;
|
||||
end;
|
||||
myPrimes[0] := false;
|
||||
myPrimes[1] := false;
|
||||
BuildWheel := pr+1;
|
||||
end;
|
||||
|
||||
procedure Sieve(PrimeLimit:Uint64);
|
||||
var
|
||||
myPrimes : pBoolean;
|
||||
sieveprime,
|
||||
fakt : NativeUint;
|
||||
begin
|
||||
setlength(BoolPrimes,PrimeLimit+1);
|
||||
|
||||
myPrimes := @BoolPrimes[0];
|
||||
sieveprime := BuildWheel(PrimeLimit);
|
||||
repeat
|
||||
if myPrimes[sieveprime] then
|
||||
begin
|
||||
fakt := PrimeLimit DIV sieveprime;
|
||||
IF fakt < sieveprime then
|
||||
BREAK;
|
||||
repeat
|
||||
myPrimes[sieveprime*fakt] := false;
|
||||
repeat
|
||||
dec(fakt);
|
||||
until myPrimes[fakt];
|
||||
until fakt < sieveprime;
|
||||
end;
|
||||
inc(sieveprime);
|
||||
until false;
|
||||
myPrimes[1] := false;
|
||||
end;
|
||||
|
||||
procedure CnvtoBASE(var dgt:tDigits;n:Uint64;base:NativeUint);
|
||||
var
|
||||
q,r: Uint64;
|
||||
i : Int32;
|
||||
Begin
|
||||
i := 0;
|
||||
with dgt do
|
||||
Begin
|
||||
fillchar(dgtDgts,SizeOf(dgtDgts),#0);
|
||||
dgtNum:= n;
|
||||
repeat
|
||||
r := n;
|
||||
q := n div base;
|
||||
r -= q*base;
|
||||
n := q;
|
||||
dgtDgts[i] := r;
|
||||
inc(i);
|
||||
until (q = 0);
|
||||
dec(i);
|
||||
dgtMaxIdx := i;
|
||||
|
||||
r := 1;
|
||||
repeat
|
||||
q := dgtDgts[i];
|
||||
if r < q then
|
||||
r := q;
|
||||
dec(i);
|
||||
until i <0 ;
|
||||
dgtMaxDgtVal := r;
|
||||
end;
|
||||
end;
|
||||
|
||||
function CnvDgtAsInBase(const dgt:tDigits;base:NativeUint):Uint64;
|
||||
var
|
||||
tmpDgt,i: NativeInt;
|
||||
Begin
|
||||
result := 0;
|
||||
with dgt do
|
||||
Begin
|
||||
i:= dgtMaxIdx;
|
||||
repeat
|
||||
tmpDgt := dgtDgts[i];
|
||||
result *= base;
|
||||
dec(i);
|
||||
result +=tmpDgt;
|
||||
until (i< 0);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure IncInBaseDigits(var dgt:tDigits;base:NativeInt);
|
||||
var
|
||||
i,q,tmp :NativeInt;
|
||||
Begin
|
||||
with dgt do
|
||||
Begin
|
||||
tmp := dgtMaxIdx;
|
||||
i := 0;
|
||||
repeat
|
||||
q := dgtDgts[i]+1;
|
||||
q -= (-ORD(q >=base) AND base);
|
||||
dgtDgts[i] := q;
|
||||
inc(i);
|
||||
until q <> 0;
|
||||
dec(i);
|
||||
if tmp < i then
|
||||
begin
|
||||
tmp := i;
|
||||
dgtMaxIdx := i;
|
||||
end;
|
||||
i := tmp;
|
||||
repeat
|
||||
tmp := dgtDgts[i];
|
||||
if q< tmp then
|
||||
q := tmp;
|
||||
dec(i);
|
||||
until i <0;
|
||||
inc(dgtNum);
|
||||
dgtMaxDgtVal := q;
|
||||
end;
|
||||
end;
|
||||
|
||||
function CntPrimeInBases(var Digits :tdigits;max:Int32):Uint32;
|
||||
var
|
||||
pr : Uint64;
|
||||
base: Uint32;
|
||||
begin
|
||||
result := 0;
|
||||
IncInBaseDigits(Digits,MAXBASE);
|
||||
base := Digits.dgtMaxDgtVal+1;
|
||||
//divisible by every base
|
||||
IF Digits.dgtDgts[0] = 0 then
|
||||
EXIT;
|
||||
IF base < MINBASE then base := MINBASE;
|
||||
// if (MAXBASE - Base) <= (max-result) then BREAK;
|
||||
max := (max+Base-MAXBASE);
|
||||
if (max>=0) then
|
||||
EXIT;
|
||||
for base := base TO MAXBASE do
|
||||
begin
|
||||
pr := CnvDgtAsInBase(Digits,base);
|
||||
inc(result,Ord(boolprimes[pr]));
|
||||
//no chance to reach max then exit
|
||||
if result<max then
|
||||
break;
|
||||
inc(max);
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetMaxBaseCnt(var dgt:tDigits;MinLmt,MaxLmt:Uint32):tSol;
|
||||
var
|
||||
i : Uint32;
|
||||
baseCnt,max,Idx: Int32;
|
||||
Begin
|
||||
setlength(result,0);
|
||||
max :=-1;
|
||||
Idx:= 0;
|
||||
For i := MinLmt to MaxLmt do
|
||||
Begin
|
||||
baseCnt := CntPrimeInBases(dgt,max);
|
||||
if baseCnt = 0 then
|
||||
continue;
|
||||
if max<=baseCnt then
|
||||
begin
|
||||
if max = baseCnt then
|
||||
begin
|
||||
inc(Idx);
|
||||
if Idx > High(result) then
|
||||
setlength(result,Idx);
|
||||
result[idx-1] := i;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Idx:= 1;
|
||||
setlength(result,1);
|
||||
result[0] := i;
|
||||
max := baseCnt;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function Out_String(n:Uint64;var s: AnsiString):Uint32;
|
||||
//out-sourced for debugging purpose
|
||||
var
|
||||
dgt:tDigits;
|
||||
sl : string[15];
|
||||
base,i: Int32;
|
||||
Begin
|
||||
result := 0;
|
||||
CnvtoBASE(dgt,n,MaxBase);
|
||||
sl := '';
|
||||
with dgt do
|
||||
begin
|
||||
base:= dgtMaxDgtVal+1;
|
||||
IF base < MINBASE then
|
||||
base := MINBASE;
|
||||
i := dgtMaxIdx;
|
||||
while (i>=0)do
|
||||
Begin
|
||||
sl += CharOfBase[dgtDgts[i]+1];
|
||||
dec(i);
|
||||
end;
|
||||
s := sl+' -> [';
|
||||
end;
|
||||
For base := base to MAXBASE do
|
||||
if boolprimes[CnvDgtAsInBase(dgt,base)] then
|
||||
begin
|
||||
inc(result);
|
||||
str(base,sl);
|
||||
s := s+sl+',';
|
||||
end;
|
||||
s[length(s)] := ']';
|
||||
end;
|
||||
|
||||
procedure Out_Sol(sol:tSol);
|
||||
var
|
||||
s : AnsiString;
|
||||
i,cnt : Int32;
|
||||
begin
|
||||
if length(Sol) = 0 then
|
||||
EXIT;
|
||||
for i := 0 to High(Sol) do
|
||||
begin
|
||||
cnt := Out_String(sol[i],s);
|
||||
if i = 0 then
|
||||
writeln(cnt);
|
||||
writeln(s);
|
||||
end;
|
||||
writeln;
|
||||
setlength(Sol,0);
|
||||
end;
|
||||
|
||||
var
|
||||
dgt:tDigits;
|
||||
T0 : Int64;
|
||||
i : NativeInt;
|
||||
lmt,minLmt : UInt64;
|
||||
begin
|
||||
T0 := GetTickCount64;
|
||||
lmt := 0;
|
||||
//maxvalue in Maxbase
|
||||
for i := 1 to MAXDIGITCOUNT do
|
||||
lmt :=lmt*MAXBASE+MAXBASE-1;
|
||||
writeln('max prime limit ',lmt);
|
||||
Sieve(lmt);
|
||||
writeln('Prime sieving ',(GetTickCount64-T0)/1000:6:3,' s');
|
||||
|
||||
T0 := GetTickCount64;
|
||||
CnvtoBASE(dgt,0,MAXBASE);
|
||||
i := 1;
|
||||
minLmt := 1;
|
||||
repeat
|
||||
write(i:2,' character strings which are prime in count bases = ');
|
||||
Out_Sol(GetMaxBaseCnt(dgt,minLmt,MAXBASE*minLmt-1));
|
||||
minLmt *= MAXBASE;
|
||||
inc(i);
|
||||
until i>MAXDIGITCOUNT;
|
||||
writeln(' Converting ',(GetTickCount64-T0)/1000:6:3,' s');
|
||||
{$IFDEF WINDOWS} readln; {$ENDIF}
|
||||
end.
|
||||
Loading…
Add table
Add a link
Reference in a new issue