Permuted multiples: Difference between revisions
Content added Content deleted
(→{{header|AppleScript}}: Further optimisation(s).) |
(→{{header|Pascal}}: still using only every digit maximal once.Now TIO.run output) |
||
Line 233: | Line 233: | ||
=={{header|Pascal}}== |
=={{header|Pascal}}== |
||
Create an array of the digits fixed 1 as first digit and 0 "1023456789"<BR> |
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; |
<lang pascal>program euler52; |
||
{$IFDEF FPC} |
{$IFDEF FPC} |
||
{$MOde DElphi} {$Optimization On} |
{$MOde DElphi} {$Optimization On,ALL} |
||
{$else} |
{$else} |
||
{$Apptype console} |
{$Apptype console} |
||
Line 243: | Line 245: | ||
sysutils; |
sysutils; |
||
const |
const |
||
BaseConvDgt :array[0..35] of char = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; |
|||
Base = 10; |
|||
MAXBASE = 12;// |
|||
type |
type |
||
TUsedDigits = array[0.. |
TUsedDigits = array[0..MAXBASE-1] of byte; |
||
tDigitsInUse = |
tDigitsInUse = set of 0..MAXBASE-1; |
||
var |
var |
||
{$ALIGN 16} |
|||
UsedDigits :tUsedDigits; |
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; |
procedure InitUsed; |
||
Var |
Var |
||
i : NativeInt; |
i : NativeInt; |
||
Begin |
Begin |
||
For i := 2 to |
For i := 2 to BASE-1 do |
||
UsedDigits[i] := i; |
UsedDigits[i] := i; |
||
UsedDigits[0] := 1; |
UsedDigits[0] := 1; |
||
Line 270: | Line 309: | ||
include(result,UsedDigits[i]); |
include(result,UsedDigits[i]); |
||
end; |
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; |
function CheckMultiples(const UsedDigits: tUsedDigits;OrgInUse:tDigitsInUse):NativeInt; |
||
var |
var |
||
{$ALIGN 16} |
|||
SumDigits :tUsedDigits; |
SumDigits :tUsedDigits; |
||
j : integer; |
|||
begin |
begin |
||
result := 0; |
result := 0; |
||
SumDigits := UsedDigits; |
SumDigits := UsedDigits; |
||
j := 2;// first doubled |
j := 2;// first doubled |
||
repeat |
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; |
break; |
||
if GetUsedSet(SumDigits) <> OrgInUse then |
if GetUsedSet(SumDigits) <> OrgInUse then |
||
break; |
break; |
||
inc(j); |
inc(j); |
||
until j > |
until j > MaxMul; |
||
found := j > MaxMul; |
|||
if found 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; |
end; |
||
procedure GetNextUsedDigit(StartIdx:NativeInt); |
procedure GetNextUsedDigit(StartIdx:NativeInt); |
||
var |
var |
||
Line 317: | Line 352: | ||
DigitTaken: Byte; |
DigitTaken: Byte; |
||
Begin |
Begin |
||
For i := StartIDx to |
For i := StartIDx to BASE-1 do |
||
Begin |
Begin |
||
// |
//Stop after first found |
||
if found then BREAK; |
|||
DigitTaken := UsedDigits[i]; |
DigitTaken := UsedDigits[i]; |
||
//swap i with Startidx |
|||
UsedDigits[i]:= UsedDigits[StartIdx]; |
UsedDigits[i]:= UsedDigits[StartIdx]; |
||
UsedDigits[StartIdx] := DigitTaken; |
UsedDigits[StartIdx] := DigitTaken; |
||
// write(StartIdx:3,i:3,DigitTaken:3,' '); |
|||
inc(steps); |
|||
IF StartIdx <gblMaxDepth then |
IF StartIdx <gblMaxDepth then |
||
GetNextUsedDigit(StartIdx+1) |
GetNextUsedDigit(StartIdx+1) |
||
else |
else |
||
CheckMultiples(UsedDigits,GetUsedSet(UsedDigits)); |
|||
check; |
|||
//undo swap i with Startidx |
//undo swap i with Startidx |
||
UsedDigits[StartIdx] := UsedDigits[i]; |
UsedDigits[StartIdx] := UsedDigits[i]; |
||
Line 333: | Line 372: | ||
end; |
end; |
||
end; |
end; |
||
var |
var |
||
T : INt64; |
T : INt64; |
||
Begin |
Begin |
||
T := GetTickCount64; |
T := GetTickCount64; |
||
For |
// For base := 4 to MAXBASE do |
||
For base := 4 to 10 do |
|||
Begin |
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; |
end; |
||
T := GetTickCount64-T; |
T := GetTickCount64-T; |
||
write('Done in ',T/1000:0:3); |
write('Done in ',T/1000:0:3,' s'); |
||
{$IFDEF WINdows} |
{$IFDEF WINdows} |
||
readln; |
readln; |
||
Line 350: | Line 400: | ||
end.</lang> |
end.</lang> |
||
{{out}} |
{{out}} |
||
<pre> |
<pre>TIO.RUN |
||
Base 4 |
|||
With 3 digits |
With 3 digits |
||
1x :102 2x:210 |
|||
steps 5 |
|||
With 4 digits |
With 4 digits |
||
1x :1032 2x:2130 |
|||
steps 10 |
|||
Base 5 |
|||
Base 6 |
|||
With 5 digits |
With 5 digits |
||
1x :10432 2x:21304 3x:32140 4x:43012 |
|||
steps 139 |
|||
With 6 digits |
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 |
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 |
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}}== |
=={{header|Perl}}== |