Smallest numbers: Difference between revisions

=={{header|Pascal}}==

{{works with|Free Pascal}}

made like Phix but own multiplikation to BASE 1E9 [[Smallest_power_of_6_whose_decimal_expansion_contains_n#Pascal|here]]

<lang pascal>program K_pow_K;

//First occurence of a numberstring with max DIGTIS digits in 6^n

{$IFDEF FPC}

{$MODE DELPHI}

{$Optimization ON,ALL}

{$ELSE}

{$APPTYPE CONSOLE}

{$ENDIF}

uses

sysutils;

const

LongWordDec = 1000*1000*1000;

POT_LIMIT = 10;

Digits = 7;

type

tMulElem = Uint32;

tMul = array of tMulElem;

tpMul = pUint32;

tPotArrN = array[0..1] of tMul;

tFound = Uint32;

var

PotArrN : tPotArrN;

Pot_N_str : AnsiString;

Str_Found : array of tFound;

FirstMissing :NativeInt;

T0 : INt64;

procedure Init_Mul(number:NativeInt);

var

MaxMulIdx : NativeInt;

Begin

MaxMulIdx := trunc(POT_LIMIT*ln(POT_LIMIT)/ln(10)/9+2);

setlength(PotArrN[0],MaxMulIdx);

setlength(PotArrN[1],MaxMulIdx);

PotArrN[0,0] := 1;

writeln(MaxMulIdx);

end;

procedure SquareMul(var Mul1,Mul2:tMul);

//Mul2 = MUl1*Mul1

var

prod,carry: Uint64;

i,j,lmt,n : NativeInt;

Begin

lmt := length(Mul1);

setlength(Mul2,2*lmt+1);

FillDword(Mul2[0],2*lmt+1,0);

lmt -= 1;

For i := 0 to lmt do

Begin

carry := 0;

n := Mul1[i];

For j := 0 to Lmt do

Begin

prod := n*Mul1[j]+Mul2[i+j]+carry;

carry := prod DIV LongWordDec;

Mul2[i+j]:=prod-carry*LongWordDec;

end;

// If carry<>0 then

Mul2[i+lmt+1] := carry;

end;

i := High(Mul2);

while (i>=1) AND (Mul2[i]=0) do

dec(i);

setlength(Mul2,i+1);

end;

procedure Mul_12(var Mul1,Mul2:tMul);

//Mul2 = Mul1*Mul2;

var

TmpMul : tMul;

carry,

n,prod: Uint64;

lmt1,lmt2,i,j : NativeInt;

begin

lmt1 := High(MUl1);

lmt2 := High(Mul2);

setlength(TmpMul,lmt1+lmt2+3);

For i := 0 to lmt1 do

Begin

carry := 0;

n := Mul1[i];

For j := 0 to lmt2 do

Begin

prod := n*Mul2[j]+TmpMul[i+j]+carry;

carry := prod DIV LongWordDec;

TmpMul[i+j]:=prod-carry*LongWordDec;

end;

TmpMul[i+lmt2+1] += carry;

end;

Mul2 := TmpMul;

setlength(TmpMul,0);

i := High(Mul2);

while (i>=1) AND (Mul2[i]=0) do

dec(i);

setlength(Mul2,i+1);

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;

j,k : NativeInt;

begin

// i := High(MUL);

j := (i+1)*9;

setlength(s,j+1);

pS := pChar(s);

// fill complete with '0'

fillchar(pS[0],j,'0');

str(Mul[i],S9);

j := length(s9);

move(s9[1],pS[0],j);

k := j;

dec(i);

If i >= 0 then

repeat

str(Mul[i],S9);// no leading '0'

j := length(s9);

inc(k,9);

//move to the right place, leading '0' is already there

move(s9[1],pS[k-j],j);

dec(i);

until i<0;

setlength(s,k);

end;

function CheckOneString(const s:Ansistring;pow:NativeInt):NativeInt;

//check every possible number from one to DIGITS digits

var

i,k,lmt,num : NativeInt;

begin

result := 0;

lmt := length(s);

For i := 1 to lmt do

Begin

k := i;

num := 0;

repeat

num := num*10+ Ord(s[k])-Ord('0');

IF (num >= FirstMissing) AND (str_Found[num] = 0) then

begin

str_Found[num]:= pow+1;

// commatize only once. reference counted string

inc(result);

if num =FirstMissing then

Begin

while str_Found[FirstMissing] <> 0 do

inc(FirstMissing);

end;

end;

inc(k)

until (k>lmt) or (k-i >DIGITS-1);

end;

end;

var

MulErg :tMUl;

i,j,number,toggle,found,decLimit: Int32;

Begin

T0 := GetTickCount64;

decLimit := 1;

For i := 1 to digits do

decLimit *= 10;

setlength(Str_Found,decLimit);

found := 0;

FirstMissing := 0;

number := 1;

repeat

setlength(MulErg,1);

MulErg[0] := 1;

setlength(PotArrN[0],1);

setlength(PotArrN[1],1);

PotArrN[0,0]:= number;

PotArrN[1,0]:= 1;

toggle := 0;

If number AND 1 <> 0 then

MulErg:= PotArrN[toggle];

j := 2;

while j <= number do

Begin

SquareMul(PotArrN[toggle],PotArrN[1-toggle]);

toggle := 1-toggle;

If number AND J <> 0 then

Mul_12(PotArrN[toggle],MulErg);

j:= j*2;

end;

ConvToStr(Pot_N_str,MulErg,High(MulErg));

inc(found,CheckOneString(Pot_N_str,number));

inc(number);

if number AND 511 = 0 then

write(#13,number:7,' with ',length(Pot_N_str), ' digits.Found ',found);

until found =decLimit;

writeln;

writeln(#10,'Found: ',found,' at ',number,' with ',length(Pot_N_str),

' digits in Time used ',(GetTickCount64-T0)/1000:8:3,' secs');

writeln ;

writeln(' 0 1 2 3 4 5 6 7 8 9');

write(0:10);

j := 1;

For i := 0 to 99 do//decLimit-1 do

begin

number := Str_Found[i]-1;

if number > 0 then

write(number:5);

if (i+1) MOD 10 = 0 then

Begin

writeln;

write(((i+1) DIV 10)*10:10);

end;

end;

writeln;

end.</lang>

{{out}}

<pre>

TIO.RUN

512 with 1385 digits.Found 334811

1024 with 3080 digits.Found 777542

1536 with 4891 digits.Found 968756

2048 with 6778 digits.Found 998285

2560 with 8722 digits.Found 999959

3072 with 10710 digits.Found 999999

Found: 1000000 at 3173 with 11107 digits in Time used 2.785 secs

0 1 2 3 4 5 6 7 8 9

0 9 1 3 5 2 4 4 3 7 9

10 10 11 5 19 22 26 8 17 16 19

20 9 8 13 7 17 4 17 3 11 18

30 13 5 23 17 18 7 17 15 9 18

40 16 17 9 7 12 28 6 23 9 24

50 23 13 18 11 7 14 4 18 14 13

60 19 11 25 17 17 6 6 8 14 27

70 11 26 8 16 9 13 17 8 15 19

80 14 21 7 21 16 11 17 9 17 9

90 15 12 13 15 27 16 18 19 21 23

100

... at home

9216 with 36533 digits.Found 9999997

Found: 10000000 at 9604 with 38244 digits in Time used 52.662 secs

</pre>