Munchausen numbers: Difference between revisions

Content deleted Content added
{{header|Pascal}}
m →‎{{header|Pascal}}: failure found wrong numbers in const DgtPotDgt, now calculating even 438579088 in an blink of an eye---
Line 284:
3435</pre>
=={{header|Pascal}}==
tried to speed things up.Only checking one arrangement of 1234123456789 instead of all 49! = 362880 permutations.
<lang pascal>{$IFDEF FPC}
But there is still a drawback of the leading zero
<lang pascal>
{$IFDEF FPC}
{$MODE objFPC}
{$ENDIF}
Line 296 ⟶ 294:
const
base = 10;
maxDigits = Base+10base-1;// set for 32-compilation.
 
// digit ^ digit ,special case 0^0 here 0
DgtPotDgt : array[0..base-1] of LongWord =
(0,1,4,27,256,3125,46566,823543,1677216,387420489);
var
DgtPotDgt : array[0..base-1] of LongWord =NativeUint;
cnt: NativeUint;
Line 326 ⟶ 323:
inc(cnt);
number := number*base;
IF digits > 01 then
Begin
For i := minDigit to base-1 do
Begin
Munch(number+i,DgtPowSum+DgtPotDgt[i],i,digits-1);
end
else
For i := minDigit to base-1 do
// number is always the smallest arrangement of the digits
Begin
IF (number+i)<= > 0(DgtPowSum+DgtPotDgt[i]) then
IF CheckSameDigits(number+i,DgtPowSum+DgtPotDgt[i]) then
Begin
//Only check, ifiF samenumber+i>0 count of digitsthen
IF trunc(ln(number+i)/ln(base)) = trunc( ln(DgtPowSum+DgtPotDgt[i])/ln(base) ) then
IF CheckSameDigits(number+i,DgtPowSum+DgtPotDgt[i]) then
writeln(DgtPowSum+DgtPotDgt[i]:20,number+i:20);
end; end;
 
end;
procedure InitDgtPotDgt;
end;
var
i,k,dgtpow: NativeUint;
Begin
// digit ^ digit ,special case 0^0 here 0
DgtPotDgt[0]:= 0;
For i := 1 to Base-1 do
Begin
dgtpow := i;
For k := 2 to i do
dgtpow := dgtpow*i;
DgtPotDgt[i] := dgtpow;
end;
end;
Begin
begin
cnt := 0;
InitDgtPotDgt;
Munch(0,0,0,3maxDigits); // 3== 4 digits :-(
writeln('Check Count ',cnt);
end.</lang>
Line 352 ⟶ 361:
<pre> 1 1
3435 3345
438579088 34578889
Check Count 28643758
real 0m0.000s002s</pre>
 
real 0m0.000s</pre>
=={{header|Perl 6}}==
<lang perl6>sub is_munchausen ( Int $n ) {