Permuted multiples: Difference between revisions

added =={{header|Pascal}}==
m (→‎{{header|Phix}}: multiple of 3 step 3)
(added =={{header|Pascal}}==)
Line 137:
5n = 714285
6n = 857142</pre>
=={{header|Pascal}}==
Create an array of the digits fixed 1 as first digit and 0 "1023456789"<BR>
Don't use the fact, that second digit must be < 6.Runtime negligible.
<lang pascal>program euler52;
{$IFDEF FPC}
{$MOde DElphi} {$Optimization On}
{$else}
{$Apptype console}
{$ENDIF}
uses
sysutils;
const
Base = 10;
type
TUsedDigits = array[0..Base-1] of byte;
tDigitsInUse = set of 0..Base-1;
var
UsedDigits :tUsedDigits;
gblMaxDepth : NativeInt;
procedure InitUsed;
Var
i : NativeInt;
Begin
For i := 2 to Base-1 do
UsedDigits[i] := i;
UsedDigits[0] := 1;
UsedDigits[1] := 0;
end;
function GetUsedSet(const UsedDigits: tUsedDigits):tDigitsInUse;
var
i : NativeInt;
begin
result := [];
For i := 0 to gblMaxDepth do
include(result,UsedDigits[i]);
end;
function CheckMultiples(const UsedDigits: tUsedDigits;OrgInUse:tDigitsInUse):NativeInt;
var
SumDigits :tUsedDigits;
i,c,s,j : integer;
begin
result := 0;
SumDigits := UsedDigits;
j := 2;// first doubled
repeat
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 > 6;
IF j > 6 then
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
i : NativeInt;
DigitTaken: Byte;
Begin
For i := StartIDx to Base-1 do
Begin
//swap i with Startidx
DigitTaken := UsedDigits[i];
UsedDigits[i]:= UsedDigits[StartIdx];
UsedDigits[StartIdx] := DigitTaken;
// write(StartIdx:3,i:3,DigitTaken:3,' ');
IF StartIdx <gblMaxDepth then
GetNextUsedDigit(StartIdx+1)
else
check;
//undo swap i with Startidx
UsedDigits[StartIdx] := UsedDigits[i];
UsedDigits[i]:= DigitTaken;
end;
end;
var
T : INt64;
Begin
T := GetTickCount64;
For gblMaxDepth := 2 to Base-1 do
Begin
InitUsed;
writeln('With ',gblMaxdepth+1,' digits');
GetNextUsedDigit(1);
end;
T := GetTickCount64-T;
write('Done in ',T/1000:0:3);
{$IFDEF WINdows}
readln;
{$ENDIF}
end.</lang>
{{out}}
<pre>
 
With 3 digits
With 4 digits
With 5 digits
With 6 digits
142857
285714
428571
571428
714285
857142
 
With 7 digits
1428570
2857140
4285710
5714280
7142850
8571420
 
1429857
2859714
4289571
5719428
7149285
8579142
 
With 8 digits
14298570
28597140
42895710
57194280
71492850
85791420
 
With 9 digits
With 10 digits
Done in 0.054</pre>
 
=={{header|Phix}}==
Anonymous user