Munchausen numbers: Difference between revisions

{{header|Pascal}}
m (removed the math tags)
({{header|Pascal}})
Line 283:
<pre>1
3435</pre>
=={{header|Pascal}}==
tried to speed things up.Only checking one arrangement of 1234 instead of all 4! permutations.
But there is still a drawback of the leading zero
<lang pascal>
{$IFDEF FPC}
{$MODE objFPC}
{$ENDIF}
uses
sysutils;
type
tdigit = byte;
const
base = 10;
maxDigits = Base+10;
// 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
cnt: NativeUint;
function CheckSameDigits(n1,n2:NativeUInt):boolean;
var
dgtCnt : array[0..Base-1] of NativeInt;
i : NativeUInt;
Begin
fillchar(dgtCnt,SizeOf(dgtCnt),#0);
repeat
//increment digit of n1
i := n1;n1 := n1 div base;i := i-n1*base;inc(dgtCnt[i]);
//decrement digit of n2
i := n2;n2 := n2 div base;i := i-n2*base;dec(dgtCnt[i]);
until (n1=0) AND (n2= 0 );
result := true;
For i := 0 to Base-1 do
result := result AND (dgtCnt[i]=0);
end;
 
procedure Munch(number,DgtPowSum,minDigit:NativeUInt;digits:NativeInt);
var
i: NativeUint;
begin
inc(cnt);
number := number*base;
IF digits > 0 then
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
Begin
IF number+i > 0 then
Begin
//Only check, if same count of digits
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;
begin
cnt := 0;
Munch(0,0,0,3); // 3== 4 digits :-(
writeln('Check Count ',cnt);
end.</lang>
{{Out}}
<pre> 1 1
3435 3345
Check Count 286
 
real 0m0.000s</pre>
=={{header|Perl 6}}==
<lang perl6>sub is_munchausen ( Int $n ) {
Anonymous user