Smallest power of 6 whose decimal expansion contains n: Difference between revisions

Content added Content deleted
(added Arturo)
m (→‎{{header|Pascal}}: corrected wrong copy (missing letter) . Minimal improvement)
Line 917: Line 917:


=={{header|Pascal}}==
=={{header|Pascal}}==
{{Works with|Free Pascal}}
==={{header|Free Pascal}}===
Doing long multiplikation like in primorial task.<BR>I used to check every numberstring one after the other on one 6^ n string.Gets really slow on high n<BR>After a closer look into [[Phix|Smallest_power_of_6_whose_decimal_expansion_contains_n#Phix]] I applied a slghtly modified version of Pete, to get down < 10 secs on my 2200G for DIGITS = 7.TIO.RUN is slower.
Doing long multiplikation like in primorial task.<BR>I used to check every numberstring one after the other on one 6^ n string.Gets really slow on high n<BR>After a closer look into [[Phix|Smallest_power_of_6_whose_decimal_expansion_contains_n#Phix]] I applied a slghtly modified version of Pete, to get down < 10 secs on my 2200G for DIGITS = 7.TIO.RUN is slower.
<syntaxhighlight lang="pascal">program PotOf6;
<syntaxhighlight lang="pascal">program PotOf6;
//First occurence of a numberstring with max DIGTIS digits in 6^n
//First occurence of a numberstring with max DIGTIS digits in 6^n
{$IFDEF FPC}
{$IFDEF FPC}
{$MODE DELPHI}
{$MODE DELPHI} {$Optimization ON,ALL} {$COPERATORS ON}
{$ENDIF}
{$Optimization ON,ALL}
{$IFDEF WINDOWS}
{$ELSE}
{$APPTYPE CONSOLE}
{$APPTYPE CONSOLE}
{$ENDIF}
{$ENDIF}
Line 931: Line 931:
sysutils;
sysutils;
const
const
//decimal places used by multiplication and for string conversion
POT_LIMIT = 70000;
{ DIGITS = 8;
calcDigits = 8;

67584 99999998 46238296
Max power 68479
// DIGITS = 8;POT_LIMIT = 68479;
DIGITS = 7;POT_LIMIT = 21798;
Found: 100000000 Time used 148.584 secs}
DIGITS = 7;
// DIGITS = 6;POT_LIMIT = 6120;
// DIGITS = 5;POT_LIMIT = 1736;
// DIGITS = 4;POT_LIMIT = 444;
// DIGITS = 3;POT_LIMIT = 147;
// DIGITS = 2;POT_LIMIT = 46;
type
type
tMulElem = Uint32;
tMulElem = Uint32;
Line 947: Line 951:
foundStr :Ansistring;
foundStr :Ansistring;
end;
end;

var
var
{$ALIGN 32}
PotArrN : tPotArrN;
PotArrN : tPotArrN;
{$ALIGN 32}
StrDec4Dgts : array[0..9999] of String[4];
{$ALIGN 32}
Str_Found : array of tFound;
Pot_N_str : AnsiString;
Pot_N_str : AnsiString;
Str_Found : array of tFound;
FirstMissing :NativeInt;
FirstMissing :NativeInt;
T0 : INt64;
T0 : INt64;


procedure Init_Mul(number:NativeInt);
procedure Init_StrDec4Dgts;
var
MaxMulIdx : NativeInt;
Begin
MaxMulIdx := trunc(POT_LIMIT*ln(number)/ln(10)/9+2);
setlength(PotArrN[0],MaxMulIdx);
setlength(PotArrN[1],MaxMulIdx);
PotArrN[0,0] := 1;
end;

function Mul_N(var Mul1,Mul2:tMul;limit,n:Uint32):NativeInt;
//Mul2 = n*Mul1. n must be < LongWordDec !
const
LongWordDec = 1000*1000*1000;
var
var
pM1,pM2 : tpMul;
s : string[4];
carry,prod : Uint64;
i : integer;
a,b,c,d : char;
begin
begin
pM1 := @Mul1[0];
i := 0;
pM2 := @Mul2[0];
s := '0000';
carry := 0;
For a := '0' to '9' do
Begin
result :=0;
s[1] := a;
repeat
prod := n*pM1[result]+Carry;
For b := '0' to '9' do
begin
Carry := prod Div LongWordDec;
pM2[result] := Prod - Carry*LongWordDec;
s[2]:=b;
For c := '0' to '9' do
inc(result);
until result > limit;
begin
IF Carry <> 0 then
s[3] := c;
pM2[result] := Carry
For d := '0' to '9' do
begin
else
dec(result);
s[4] := d;
StrDec4Dgts[i]:= s;
inc(i);
end;
end;
end;
end;
end;
end;


Line 1,001: Line 1,002:
exit;
exit;
end;
end;
toIdx := 4*(toIdx DIV 3)+toIdx MOD 3;
toIdx := 4*(toIdx DIV 3)+toIdx MOD 3 +1 ;
inc(toIdx);
setlength(result,toIdx);
setlength(result,toIdx);
repeat
repeat
result[toIdx] := s[FromIdx];
result[toIdx] := s[FromIdx];
result[toIdx-1] := s[FromIdx-1];
result[toIdx-1] := s[FromIdx-1];
result[toIdx-2] := s[FromIdx-2];
result[toIdx-2] := s[FromIdx-2];
Line 1,018: Line 1,018:
dec(fromIdx);
dec(fromIdx);
end;
end;
end;

procedure Init_Mul(number:NativeInt);
var
MaxMulIdx : NativeInt;
Begin
MaxMulIdx := trunc(POT_LIMIT*ln(number)/ln(10)/calcDigits+2);
setlength(PotArrN[0],MaxMulIdx);
setlength(PotArrN[1],MaxMulIdx);
PotArrN[0,0] := 1;
end;

function Mul_6(var Mul1,Mul2:tMul;limit:Uint32):NativeInt;
//Mul2 = n*Mul1. n must be < LongWordDec !
const
LongWordDec = 100*1000*1000;
var
pM1,pM2 : tpMul;
carry,prod : Uint64;
begin
pM1 := @Mul1[0];
pM2 := @Mul2[0];
carry := 0;
result :=0;
repeat
prod := 6*pM1[result]+Carry;
Carry := prod Div LongWordDec;
pM2[result] := Prod - Carry*LongWordDec;
inc(result);
until result > limit;
IF Carry <> 0 then
pM2[result] := Carry
else
dec(result);
end;
end;


procedure ConvToStr(var s:Ansistring;const Mul:tMul;i:NativeInt);
procedure ConvToStr(var s:Ansistring;const Mul:tMul;i:NativeInt);
var
var
s9: string[9];
s8: string[8];
pS : pChar;
pS : pChar;
j,k : NativeInt;
j,k,d,m : NativeInt;
begin
begin
// i := High(MUL);
j := (i+1)*calcDigits;
j := (i+1)*9;
setlength(s,j+1);
setlength(s,j+1);
pS := pChar(s);
pS := @s[1];
m := Mul[i];
// fill complete with '0'
fillchar(pS[0],j,'0');
str(Mul[i],s8);
j := length(s8);
str(Mul[i],S9);
move(s8[1],pS[0],j);
j := length(s9);
move(s9[1],pS[0],j);
k := j;
k := j;
dec(i);
dec(i);
If i >= 0 then
If i >= 0 then
repeat
repeat
str(Mul[i],S9);// no leading '0'
m := MUL[i];
j := length(s9);
d := m div 10000;
inc(k,9);
m := m-10000*d;
move(StrDec4Dgts[d][1],pS[k],4);
//move to the right place, leading '0' is already there
move(s9[1],pS[k-j],j);
move(StrDec4Dgts[m][1],pS[k+4],4);
inc(k,calcDigits);
dec(i);
dec(i);
until i<0;
until i<0;
Line 1,050: Line 1,083:


function CheckOneString(const s:Ansistring;pow:NativeInt):NativeInt;
function CheckOneString(const s:Ansistring;pow:NativeInt):NativeInt;
//check every possible number from one to DIGITS digits,
//check every possible number from one to DIGITS digits,
//if it is still missing in the list
//if it is still missing in the list
var
var
Line 1,073: Line 1,106:
str_Found[num].foundStr:= cs;
str_Found[num].foundStr:= cs;
inc(result);
inc(result);
if num =irstMissing then
if num =FirstMissing then
while str_Found[FirstMissing].foundIndex <> 0 do
while str_Found[FirstMissing].foundIndex <> 0 do
inc(FirstMissing);
inc(FirstMissing);
Line 1,086: Line 1,119:
Begin
Begin
T0 := GetTickCount64;
T0 := GetTickCount64;
number := 6;//<1e9 no power of 10 ;-)
number := 6;
decLimit := 1;
decLimit := 1;
For i := 1 to digits do
For i := 1 to digits do
decLimit *= 10;
decLimit *= 10;
setlength(Str_Found,decLimit);
setlength(Str_Found,decLimit);
FirstMissing := 0;
Init_StrDec4Dgts;
Init_Mul(number);
Init_Mul(number);


toggle := 0;
toggle := 0;
found := 0;
found := 0;
FirstMissing := 0;
MaxMulIdx := 0;
MaxMulIdx := 0;
For j := 0 to POT_LIMIT do
For j := 0 to POT_LIMIT do
Line 1,101: Line 1,135:
ConvToStr(Pot_N_str,PotArrN[toggle],MaxMulIdx);
ConvToStr(Pot_N_str,PotArrN[toggle],MaxMulIdx);
inc(found,CheckOneString(Pot_N_str,j));
inc(found,CheckOneString(Pot_N_str,j));
MaxMulIdx := Mul_N(PotArrN[toggle],PotArrN[1-toggle],MaxMulIdx,number);
MaxMulIdx := Mul_6(PotArrN[toggle],PotArrN[1-toggle],MaxMulIdx);
toggle := 1-toggle;
toggle := 1-toggle;
if found>=decLimit then
if FirstMissing = decLimit then
Begin
Begin
writeln(#10,'Max power ',j);
writeln(#10,'Max power ',j);
break;
break;
end;
end;
// show me, that the program still runs
if (j and 1023) = 0 then
if (j and 1023) = 0 then
write(j:10,found:10,firstMissing:10,#13);
write(#13,j:10,found:10,FirstMissing:10);
end;
end;


writeln(#10,'Found: ',found,' Time used ',(GetTickCount64-T0)/1000:8:3,' secs');
writeln(#13#10,'Found: ',found,' Time used ',(GetTickCount64-T0)/1000:8:3,' secs');
For i := 0 to 22 do//decLimit-1 do
For i := 0 to 22 do//decLimit-1 do
with Str_Found[i] do
with Str_Found[i] do
if foundIndex >0 then
writeln(i:10,' ',number,'^',foundIndex-1:5,' ',foundStr);
writeln(i:10,' ',number,'^',foundIndex-1:5,' ',foundStr);
readln;
end.</syntaxhighlight>
end.</syntaxhighlight>
{{out}}
{{out}}
<pre>
<pre>
TIO.RUN output
TIO.RUN output
//Power found first missing
// Power found first missing
0 1 0
0 1 0
1024 751817 10020
1024 751817 10020
Line 1,147: Line 1,180:
Max power 21798
Max power 21798


Found: 10000000 Time used 14.882 secs
Found: 10000000 Time used 13.717 secs
0 6^ 9 10,077,696
0 6^ 9 10,077,696
1 6^ 0 1
1 6^ 0 1
Line 1,172: Line 1,205:
22 6^ 22 131,621,703,842,267,136
22 6^ 22 131,621,703,842,267,136


Real time: 14.350 s User time: 13.900 s Sys. time: 0.268 s CPU share: 98.74 %
Real time: 15.373 s
</pre>
User time: 14.953 s
Sys. time: 0.254 s
CPU share: 98.92 %</pre>


=={{header|Perl}}==
=={{header|Perl}}==
Retrieved from "https://rosettacode.org/wiki/Smallest_power_of_6_whose_decimal_expansion_contains_n"