Rosetta Code

Multi-base primes: Difference between revisions

Page Discussion

Multi-base primes (view source)

Revision as of 16:44, 4 July 2021

435 bytes added ,  2 years ago
m
→‎{{header|Pascal}}: small improvement using digits getDecDigitsAndMaxDgt like Julia->Rust->Phix etc...
(Realize in F#)
m (→‎{{header|Pascal}}: small improvement using digits getDecDigitsAndMaxDgt like Julia->Rust->Phix etc...)
Line 455:
{$MODE DELPHI}
{$OPTIMIZATION ON,ALL}
// {$R+,O+}
{$CodeAlign proc=32,loop=1}
{$ELSE}
{$APPTYPE CONSOLE}
Line 463:
const
MINBASE = 2;
MAXBASE = 36;//10;//10 is minimum
MAXFACPOTMAXDIGITCOUNT = 6;//9;//
MAXFAC = 10*10*10*10*10*10;//10*10*10*10*10*10*10*10*10;//
type
tdigits = array [0..15] of byte;
tChkLst = array of byte;
tSol = array of Uint32;
Line 472 ⟶ 473:
var
BoolPrimes: array of boolean;
ChkLstBaseCnvCount :tChkLst;
 
function popcnt64(n:Uint64):integer;
begin
result := 0;
repeat
result += ORD(n AND 1 <> 0);
n := n shr 1;
until n = 0;
end;
 
function BuildWheel(primeLimit:Int32):NativeUint;
Line 539 ⟶ 531:
myPrimes[1] := false;
BuildWheel := pr+1;
writeln;
end;
 
Line 570 ⟶ 561:
end;
 
function CnvtoBasegetDecDigitsAndMaxDgt(n,base:Uint32;var dgt:tDigits):Uint32uint32;
//with test of digit >= base
var
q,r,faci: Uint32;
Begin
fillChar(dgt[0],SizeOf(dgt),#0);
fac := 1;
i := 0;
result := 0;
repeat
q := n DIV 10;
r := (n-q*10);
if r >= base then
break;
result += fac*r;
fac *= base;
n := q;
until (n dgt[i] := 0)r;
if r >= base theninc(i);
if result :=< r 0;then
result := r;
until n = 0;
end;
 
function CnvtoBase11toMAXBASECnvtoBase(n,const dgt:tDigits;base:Uint32):Uint32;
var
q,r,faci: Uint32Int32;
Begin
faci := 1MAXDIGITCOUNT;
while (dgt[i] = 0) AND (i>0) do
dec(i);
 
result := 0;
repeat
qresult := n DIV 10base*result+dgt[i];
r := dec(n-q*10i);
until (i< 0);
result += fac*r;
fac *= Base;
n := q;
until n = 0;
end;
 
procedure ConvertToBases(n:Uint32);
var
Digits :tdigits;
base,r,Counter: Uint32;
base,minimalBase,Counter: Uint32;
begin
Counter := 0;
//base 10
ifCounter := Ord(boolprimes[n] then);
//minimalBase <= max. digit +1
inc(Counter);
minimalBase := getDecDigitsAndMaxDgt(n,Digits)+1;
for base := MINBASE TO 9 do
if minimalBase < MinBase then
Begin
rminimalBase := CnvtoBase(n,base)MinBase;
// if boolprimes[r] then inc(Counter);
inc(Counter,Ord(boolprimes[r]));
end;
 
for base := minimalBase TO 9 do
inc(counter,Ord(boolprimes[CnvtoBase(Digits,base)]));
for base := 11 TO MAXBASE do
inc(counter,Ord(boolprimes[CnvtoBase(Digits,base)]));
Begin
 
r := CnvtoBase11toMAXBASE(n,base);
// if boolprimesBaseCnvCount[rn] then:= inc(Counter);
inc(Counter,Ord(boolprimes[r]));
end;
chklst[n] := Counter;
end;
 
Line 633 ⟶ 618:
i,pc,max,Idx: Int32;
Begin
setlength(result,100);
max :=-1;
Idx:= 0;
For i := MinLmt to MaxLmt do
Begin
pc := ChkLstBaseCnvCount[i];
if pc= 0 then
continue;
if max<=pc then
begin
Line 645 ⟶ 632:
inc(Idx);
if Idx > High(result) then
setlength(result,Idx+10);
result[idx-1] := i;
end
Line 651 ⟶ 638:
begin
Idx:= 1;
setlength(result,1);
result[Idx-1] := i;
max := pc;
Line 656 ⟶ 644:
end;
end;
setlength(result,idx);
end;
 
function Out_String(n:Uint32;var s: AnsiString):Uint32;
procedure Out_Sol(sol:tSol);
var
dgt:tDigits;
sl : string[8];
base,minimalbase: Uint32;
Begin
result := 0;
minimalbase:= getDecDigitsAndMaxDgt(n,dgt)+1;
str(n:7,sl);
s := sl+' -> [';
For base := minimalbase to MAXBASE do
if boolprimes[CnvtoBase(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,n,base,r,cnt : Uint32Int32;
begin
if length(Sol) = 0 then
EXIT;
cnt := 0;
for i := 0 to High(Sol) do
begin
ncnt := Out_String(sol[i],s);
str(n:7,sl);
s := sl+' -> [';
For base := MINBASE to MAXBASE do
Begin
r := CnvtoBase(n,base);
if boolprimes[r] then
begin
inc(cnt);
str(base,sl);
s := s+sl+',';
end;
end;
s[length(s)] := ']';
if i = 0 then
writeln(cnt);
Line 691 ⟶ 683:
setlength(Sol,0);
end;
 
var
T0 : Int64;
Line 698 ⟶ 691:
lmt := 0;
//maxvalue of "99...99" in Maxbase
for i := 1 to MAXFACPOTMAXDIGITCOUNT do
lmt := (lmt*MAXBASE+9);
writeln('max prime limit ',lmt);
Sieve(lmt);
Setlength(ChkLstBaseCnvCount,MAXFAC);
 
writeln('Start ',(GetTickCount64-T0)/1000:6:3,' s');
write('Prime sieving ',(GetTickCount64-T0)/1000:6:3,' s');
For i := 2 to MAXFAC-1 do
T0 := GetTickCount64;
For i := High(BaseCnvCount) downto 2 do
ConvertToBases(i);
writeln(' Converting ',(GetTickCount64-T0)/1000:6:3,' s');
writeln;
 
i := 1;
minLmt := 1;
repeat
write(i:2,' character strings which are prime in mostcount bases: = ');
Out_Sol(GetMax(minLmt,10*minLmt-1));
minLmt *= 10;
Line 719 ⟶ 716:
{{out}}
<pre>
TIO.RUN // extreme volatile timings ala Prime sieving 7.7 s .. 4,7s Converting nearly stable
TIO.RUN
max prime limit 559744029
Prime sieving 2.098 s Converting 0.368 s
 
1 character strings which are prime in count bases = 34
Start 2.343 s
1 character strings which are prime in most bases: 34
2 -> [3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36]
 
2 character strings which are prime in mostcount bases: = 18
21 -> [3,5,6,8,9,11,14,15,18,20,21,23,26,29,30,33,35,36]
 
3 character strings which are prime in mostcount bases: = 18
131 -> [4,5,7,8,9,10,12,14,15,18,19,20,23,25,27,29,30,34]
551 -> [6,7,11,13,14,15,16,17,19,21,22,24,25,26,30,32,35,36]
737 -> [8,9,11,12,13,15,16,17,19,22,23,24,25,26,29,30,31,36]
 
4 character strings which are prime in mostcount bases: = 19
1727 -> [8,9,11,12,13,15,16,17,19,20,22,23,24,26,27,29,31,33,36]
5347 -> [8,9,10,11,12,13,16,18,19,22,24,25,26,30,31,32,33,34,36]
 
5 character strings which are prime in mostcount bases: = 18
30271 -> [8,10,12,13,16,17,18,20,21,23,24,25,31,32,33,34,35,36]
 
6 character strings which are prime in mostcount bases: = 18
441431 -> [5,8,9,11,12,14,16,17,19,21,22,23,26,28,30,31,32,33]
 
Real time: 32.047658 s User time: 2.295 s Sys. time: 0.319 s CPU share: 9798.0731 %
//at home
//Start 1.077 s real 0m1,364s at home</pre>
//Prime sieving 1.072 s Converting 0.181 s</pre>
 
=={{header|Phix}}==
Anonymous user
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/313401"