Rosetta Code

Permuted multiples: Difference between revisions

Page Discussion

Permuted multiples (view source)

Revision as of 11:25, 18 August 2021

1,782 bytes added ,  2 years ago
→‎{{header|Pascal}}: still using only every digit maximal once.Now TIO.run output
(→‎{{header|AppleScript}}: Further optimisation(s).)
(→‎{{header|Pascal}}: still using only every digit maximal once.Now TIO.run output)
Line 233:
=={{header|Pascal}}==
Create an array of the digits fixed 1 as first digit and 0 "1023456789"<BR>
Adding done digit by digit, so no conversion needed.<BR>
Don't use the fact, that second digit must be < 6.Runtime negligible.
Using set of tdigit ,so no sort of digits is required.<BR>
Don't use the fact, that second digit must be < 6.Runtime negligible.<BR>
<lang pascal>program euler52;
{$IFDEF FPC}
{$MOde DElphi} {$Optimization On,ALL}
{$else}
{$Apptype console}
Line 243 ⟶ 245:
sysutils;
const
BaseConvDgt :array[0..35] of char = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
Base = 10;
MAXBASE = 12;//
type
TUsedDigits = array[0..BaseMAXBASE-1] of byte;
tDigitsInUse = set of 0..BaseMAXBASE-1;
var
{$ALIGN 16}
UsedDigits :tUsedDigits;
{$ALIGN 16}
gblMaxDepth : NativeInt;
gblMaxDepth,
steps,
base,maxmul : NativeInt;
found : boolean;
function AddOne(var SumDigits:tUsedDigits;const UsedDigits: tUsedDigits):NativeInt;forward;
function ConvBaseToStr(const UsedDigits :tUsedDigits):string;
var
i,j:NativeUint;
Begin
setlength(result,gblMaxdepth+1);
j := 1;
For i := 0 to gblMaxdepth do
begin
result[j] := BaseConvDgt[UsedDigits[i]];
inc(j);
end;
end;
 
procedure Out_MaxMul(const UsedDigits :tUsedDigits);
var
j : NativeInt;
SumDigits :tUsedDigits;
begin
writeln('With ',gblMaxdepth+1,' digits');
sumDigits := UsedDigits;
write(' 1x :',ConvBaseToStr(UsedDigits));
For j := 2 to MaxMul do
Begin
AddOne(SumDigits,UsedDigits);
write(j:2,'x:',ConvBaseToStr(SumDigits));
end;
writeln;
writeln('steps ',steps);
end;
 
procedure InitUsed;
Var
i : NativeInt;
Begin
For i := 2 to BaseBASE-1 do
UsedDigits[i] := i;
UsedDigits[0] := 1;
Line 270 ⟶ 309:
include(result,UsedDigits[i]);
end;
 
function AddOne(var SumDigits:tUsedDigits;const UsedDigits: tUsedDigits):NativeInt;
//add and return carry
var
s,i: NativeUint;
begin
result := 0;
For i := gblMaxdepth downto 0 do
Begin
s := UsedDigits[i]+SumDigits[i]+result;
result := ord(s >= BASE);// 0 or 1
// if result >0 then s -= base;//runtime Base=12 Done in 2.097 -> Done in 1.647
s -= result*base;
SumDigits[i] := s;
end;
end;
 
function CheckMultiples(const UsedDigits: tUsedDigits;OrgInUse:tDigitsInUse):NativeInt;
var
{$ALIGN 16}
SumDigits :tUsedDigits;
i,c,s,j : integer;
begin
result := 0;
SumDigits := UsedDigits;
j := 2;// first doubled
repeat
if AddOne(SumDigits,UsedDigits) >0 then
c := 0;
For i := gblMaxdepth downto 0 do
Begin
s := UsedDigits[i]+SumDigits[i]+c;
c := ord(s >= base);
SumDigits[i] := s-c*base;
end;
IF (c > 0) then
break;
if GetUsedSet(SumDigits) <> OrgInUse then
break;
inc(j);
until j > 6MaxMul;
found := j > MaxMul;
IFif j > 6found then
Out_MaxMul(UsedDigits);
Begin
result := 0;
//Output in Base 10
For i := 0 to gblMaxdepth do
result := result * Base +UsedDigits[i];
For i := 1 to 6 do
writeln(i*result);
writeln;
end;
end;
procedure Check;
Begin
CheckMultiples(UsedDigits,GetUsedSet(UsedDigits))
end;
 
procedure GetNextUsedDigit(StartIdx:NativeInt);
var
Line 317 ⟶ 352:
DigitTaken: Byte;
Begin
For i := StartIDx to BaseBASE-1 do
Begin
//swapStop iafter withfirst Startidxfound
if found then BREAK;
DigitTaken := UsedDigits[i];
//swap i with Startidx
UsedDigits[i]:= UsedDigits[StartIdx];
UsedDigits[StartIdx] := DigitTaken;
 
// write(StartIdx:3,i:3,DigitTaken:3,' ');
inc(steps);
IF StartIdx <gblMaxDepth then
GetNextUsedDigit(StartIdx+1)
else
CheckMultiples(UsedDigits,GetUsedSet(UsedDigits));
check;
//undo swap i with Startidx
UsedDigits[StartIdx] := UsedDigits[i];
Line 333 ⟶ 372:
end;
end;
 
var
T : INt64;
Begin
T := GetTickCount64;
// For gblMaxDepthbase := 24 to Base-1MAXBASE do
For base := 4 to 10 do
Begin
Writeln('Base ',base);
InitUsed;
MaxMul := Base-2;
writeln('With ',gblMaxdepth+1,' digits');
If base = 10 then
GetNextUsedDigit(1);
MaxMul := 6;
InitUsed;
steps := 0;
For gblMaxDepth := 1 to BASE-1 do
Begin
found := false;
GetNextUsedDigit(1);
end;
writeln;
end;
T := GetTickCount64-T;
write('Done in ',T/1000:0:3,' s');
{$IFDEF WINdows}
readln;
Line 350 ⟶ 400:
end.</lang>
{{out}}
<pre>TIO.RUN
Base 4
 
With 3 digits
1x :102 2x:210
steps 5
With 4 digits
1x :1032 2x:2130
steps 10
 
Base 5
 
Base 6
With 5 digits
1x :10432 2x:21304 3x:32140 4x:43012
steps 139
With 6 digits
1x :105432 2x:215304 3x:325140 4x:435012
142857
steps 197
285714
428571
571428
714285
857142
 
Base 7
 
Base 8
With 7 digits
1x :1065432 2x:2153064 3x:3240516 4x:4326150 5x:5413602 6x:6501234
1428570
steps 5945
2857140
With 8 digits
4285710
1x :10765432 2x:21753064 3x:32740516 4x:43726150 5x:54713602 6x:65701234
5714280
steps 7793
7142850
8571420
 
Base 9
1429857
2859714
4289571
5719428
7149285
8579142
 
Base 10
With 6 digits
1x :142857 2x:285714 3x:428571 4x:571428 5x:714285 6x:857142
steps 10725
With 7 digits
1x :1428570 2x:2857140 3x:4285710 4x:5714280 5x:7142850 6x:8571420
steps 37956
With 8 digits
1x :14298570 2x:28597140 3x:42895710 4x:57194280 5x:71492850 6x:85791420
14298570
steps 128297
28597140
42895710
57194280
71492850
85791420
 
Done in 0.044 s</pre>
With 9 digits
With 10 digits
Done in 0.054</pre>
 
=={{header|Perl}}==
Anonymous user
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/315142"