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

→‎{{header|Pascal}}: searching for strings changed to Phix version.
(Add Python)
(→‎{{header|Pascal}}: searching for strings changed to Phix version.)
Line 350:
=={{header|Pascal}}==
{{Works with|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.
<lang pascal>program PotOf6;
//First occurence of a numberstring with max DIGTIS digits in 6^n
{$IFDEF FPC} {$MODE DELPHI} {$ENDIF}
{$IFDEF FPC}
{$MODE DELPHI}
{$Optimization ON,ALL}
{$ELSE}
{$APPTYPE CONSOLE}
{$ENDIF}
 
uses
sysutils,strutils;
const
// POT_LIMIT = 626070000;DEC_LIMIT = 1000000;//'575115' in 6^6260
{ DIGITS = 8;
// POT_LIMIT = 1736;DEC_LIMIT = 100000;
67584 99999998 46238296
//'83081' in 6^1736 mean power 422.48
Max power 68479
// POT_LIMIT = 444; DEC_LIMIT = 10000;
Found: 100000000 Time used 148.584 secs}
//'2565' mean power 135.82 0.157s
DIGITS = 7;
// POT_LIMIT = 147; DEC_LIMIT = 1000;
//'120' mean power 44.21
// POT_LIMIT = 46; DEC_LIMIT = 100;
//'52' mean power 15.71
POT_LIMIT = 28;DEC_LIMIT = 22;
//'14' mean power 9.73
 
type
tMulElem = Uint32;
tMul = array of tMulElem;
tpMul = pUint32;
tPotArrN = array[0..1] of tMul;
 
tFound = record
foundIndex: Uint32;
foundStr :Ansistring;
end;
 
var
Pot_N_strPotArrN : array of: AnsiStringtPotArrN;
Pot_N_str : AnsiString;
T0,maxPow,PowerSum,lastpot,SumLenght : INt64;
Str_Found : array of tFound;
FirstMissing :NativeInt;
T0 : INt64;
 
procedure Init_Mul(number:NativeInt);
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
pM1,pM2 : tpMul;
carry,prod : Uint64;
begin
pM1 := @Mul1[0];
pM2 := @Mul2[0];
carry := 0;
result :=0;
repeat
prod := n*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;
 
function Commatize(const s: AnsiString):AnsiString;
var
fromIdx,toIdx :Int32;
Begin
result := '';
fromIdx := length(s);
toIdx := fromIdx-1;
if toIdx < 3 then
Begin
result := s;
exit;
end;
toIdx := 4*(toIdx DIV 3)+toIdx MOD 3;
inc(toIdx);
setlength(result,toIdx);
repeat
result[toIdx] := s[FromIdx];
result[toIdx-1] := s[FromIdx-1];
result[toIdx-2] := s[FromIdx-2];
result[toIdx-3] := ',';
dec(toIdx,4);
dec(FromIdx,3);
until FromIdx<=3;
while fromIdx>=1 do
Begin
result[toIdx] := s[FromIdx];
dec(toIdx);
dec(fromIdx);
end;
end;
 
procedure ConvToStr(var s:Ansistring;const Mul:tMul;i:NativeInt);
var
s9: string[9];
pS : pChar;
i,j,k : NativeInt;
begin
// i := High(MUL);
j := (i+1)*9;
setlength(s,j+1);
Line 402 ⟶ 479:
until i<0;
setlength(s,k);
inc(SumLenght,k);
end;
 
function Mul_NCheckOneString(varconst Muls:tMulAnsistring;npow:Uint64NativeInt):tMulNativeInt;
//check every possible number from one to DIGITS digits,
//n<LongWordDec !
//if it is still missing in the list
const
LongWordDec = 1000*1000*1000;
var
prodi,carryk,lmt,num : Uint64NativeInt;
jcs : NativeIntAnsistring;
begin
Setlength(result,length(Mul)+1) := 0;
carrycs := 0'';
For jlmt := 0 to Highlength(Muls) do;
For i := 1 to lmt do
Begin
prod k := n*Mul[j]+Carryi;
Carrynum := prod Div LongWordDec0;
repeat
result[j] := Prod - Carry*LongWordDec;
num := num*10+ Ord(s[k])-Ord('0');
IF (num >= FirstMissing) AND (str_Found[num].foundIndex = 0) then
begin
str_Found[num].foundIndex:= pow+1;
// commatize only once. reference counted string
if cs ='' then
cs := Commatize(s);
str_Found[num].foundStr:= cs;
inc(result);
if num =irstMissing then
while str_Found[FirstMissing].foundIndex <> 0 do
inc(FirstMissing);
end;
inc(k)
until (k>lmt) or (k-i >DIGITS-1);
end;
IF Carry <> 0 then
result[High(Mul)+1] := Carry
else
Setlength(result,length(Mul));
end;
 
procedure OutS(const s:Ansistring;j:nativeInt);
begin
writeln(s,' ',j);
end;
 
procedure GeneratePot_N_Str(number:NativeInt);
var
i,j,number,toggle,MaxMulIdx,found,decLimit: Int32;
PotArrN : array[0..1] of tMul;
i,toggle : NativeInt;
Begin
T0 := GetTickCount64;
setlength(Pot_N_str,POT_LIMIT+1);
number := 6;//<1e9 no power of 10 ;-)
Pot_N_str[0] := '1';
decLimit := 1;
Pot_N_str[1] := IntToStr(number);
For i := 1 to digits do
decLimit *= 10;
setlength(Str_Found,decLimit);
Init_Mul(number);
 
setlength(PotArrN[0],1);
setlength(PotArrN[1],1);
PotArrN[0,0] := 1;
PotArrN[1,0] := number;
 
//create all pot of numbers up to number**POT_LIMIT with clean up in parallel
SumLenght :=0;
i := 2;
toggle := 0;
found := 0;
while i <= POT_LIMIT do
FirstMissing := 0;
begin
MaxMulIdx := 0;
PotArrN[toggle] := Mul_N(PotArrN[1-toggle],number);
For j := 0 to POT_LIMIT do
ConvToStr(Pot_N_str[i],PotArrN[toggle]);
Begin
ConvToStr(Pot_N_str,PotArrN[toggle],MaxMulIdx);
inc(found,CheckOneString(Pot_N_str,j));
MaxMulIdx := Mul_N(PotArrN[toggle],PotArrN[1-toggle],MaxMulIdx,number);
toggle := 1-toggle;
if found>=decLimit then
inc(i);
end;
writeln(' used by strings ',Numb2USA(IntToStr(SumLenght)),' bytes');
end;
procedure OutT(const s: Ansistring;j:NativeInt);
Begin
writeln(j:10,maxPow/(j+1):8:2,(maxPow-lastPot)/1024:8:2,(GetTickCount64-T0)/1000:10:3);
T0 := GetTickCount64;
lastpot := maxPow;
end;
var
s: ansistring;
i,j,number: Int32;
Begin
number := 6;
T0 := GetTickCount64;
GeneratePot_N_Str(number);
writeln('Generating time to power limit ',(GetTickCount64-T0)/1000:5:3,'s');
 
T0 := GetTickCount64;
maxPow := 0;
lastpot := 0;
For i := 0 to DEC_LIMIT-1 do
begin
str(i,s);
For j := 0 to POT_LIMIT do
Begin
writeln(#10,'Max power ',j);
if Pos(s,Pot_N_str[j])>0 then
Beginbreak;
IF maxPow<j then
maxPow := J;
PowerSum +=j;
IF POT_Limit > 99 then
write(s:3,number:3,'^',j:5,maxPow:6,#13)
else
writeln(s:3,number:3,'^',j:2,' ', Pot_N_str[j]);
break;
end;
end;
if (j and 1023) = 0 then
write(j:10,found:10,firstMissing:10,#13);
end;
 
writeln;
writeln(#10,'meanFound: power',found,' toTime findused string',PowerSum(GetTickCount64-T0)/DEC_LIMIT1000:8:23,' secs');
For i := 0 to 22 do//decLimit-1 do
with Str_Found[i] do
if foundIndex >0 then
writeln(i:10,' ',number,'^',foundIndex-1:5,' ',foundStr);
readln;
end.</lang>
{{out}}
<pre>
TIO.RUN output
used by strings 330
//Power found first missing
Generating time to power limit 0.000s
0 6^ 9 10077696 1 0
1 6^ 0 1024 1 751817 10020
2 6^ 3 2048 216 2168981 100017
3 6^ 2 3072 36 3733971 100017
4 6^ 6 4096 46656 5305316 100672
5 6^ 6 5120 46656 6747391 104835
6 6^ 1 6144 6 7922626 575115
7 6^ 5 7168 7776 8776137 1000007
8192 9336696 1000015
8 6^12 2176782336
9 6^ 4 9216 1296 9667898 1000020
10240 9846933 1000088
10 6^ 9 10077696
11264 9935108 1000135
11 6^16 2821109907456
12288 9974783 1000204
12 6^ 4 1296
13312 9990953 1000204
13 6^13 13060694016
14336 9997035 1000204
14 6^28 6140942214464815497216
15360 9999102 1000204
15 6^18 101559956668416
16384 9999744 1029358
16 6^ 3 216
17408 9999934 1029358
17 6^10 60466176
18432 9999978 1029358
18 6^15 470184984576
19456 9999997 8091358
19 6^21 21936950640377856
20480 9999999 8091358
20 6^26 170581728179578208256
21504 9999999 8091358
21 6^ 3 216
Max power 21798
 
mean power to find string 9.73
 
Found: 10000000 Time used 14.882 secs
//Search strings 0 to 99999
0 6^ 9 10,077,696
used by strings 1,174,099 bytes
1 6^ 0 1
Generating time to power limit 0.008s
99999 2 6^ 1287 1736 3 216
3 6^ 2 36
mean power to find string 422.48
4 6^ 6 46,656
5 6^ 6 46,656
6 6^ 1 6
7 6^ 5 7,776
8 6^ 12 2,176,782,336
9 6^ 4 1,296
10 6^ 9 10,077,696
11 6^ 16 2,821,109,907,456
12 6^ 4 1,296
13 6^ 13 13,060,694,016
14 6^ 28 6,140,942,214,464,815,497,216
15 6^ 18 101,559,956,668,416
16 6^ 3 216
17 6^ 10 60,466,176
18 6^ 15 470,184,984,576
19 6^ 21 21,936,950,640,377,856
20 6^ 26 170,581,728,179,578,208,256
21 6^ 3 216
22 6^ 22 131,621,703,842,267,136
 
Real time: 15.373 s
real 0m14,684s
User time: 14.953 s
user 0m14,522s</pre>
Sys. time: 0.254 s
CPU share: 98.92 %</pre>
 
=={{header|Perl}}==
Anonymous user