Munchausen numbers

Munchausen numbers is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

A Munchausen number is a natural number n the sum of whose digits (in base 10), each raised to the power of itself, equals n.

For instance: 3435 = 3^3+4^4+3^3+5^5

Task

Find all Munchausen numbers between 1 and 5000

ALGOL 68

<lang algol68># Find Munchausen Numbers between 1 and 5000 #

1. note that 6^6 is 46 656 so we only need to cosider numbers consisting of 0 to 5 #

1. table of Nth powers - note 0^0 is 0 for Munchausen numbers, not 1 #

[]INT nth power = ([]INT( 0, 1, 2 * 2, 3 * 3 * 3, 4 * 4 * 4 * 4, 5 * 5 * 5 * 5 * 5 ))[ AT 0 ];

INT d1 := 0; INT d1 part := 0; INT d2 := 0; INT d2 part := 0; INT d3 := 0; INT d3 part := 0; INT d4 := 1; WHILE d1 < 6 DO

   INT number           = d1 part + d2 part + d3 part + d4;
   INT digit power sum := nth power[ d1 ]
                        + nth power[ d2 ]
                        + nth power[ d3 ]
                        + nth power[ d4 ];
   IF digit power sum = number THEN
       print( ( whole( number, 0 ), newline ) )
   FI;
   d4 +:= 1;
   IF d4 > 5 THEN
       d4       := 0;
       d3      +:= 1;
       d3 part +:= 10;
       IF d3 > 5 THEN
           d3       := 0;
           d3 part  := 0;
           d2      +:= 1;
           d2 part +:= 100;
           IF d2 > 5 THEN
               d2       := 0;
               d2 part  := 0;
               d1      +:= 1;
               d1 part +:= 1000;
           FI
       FI
   FI

OD </lang>

Output:

1
3435

AppleScript

<lang AppleScript>

on run

   filter(isMunchausen, range(1, 5000))
   
   --> {1, 3435}
   

end run

-- isMunchausen :: Int -> Bool on isMunchausen(n)

   (class of n is integer) and ¬
       foldl(my digitPowerSum, 0, characters of (n as string)) = n

end isMunchausen

-- digitPowerSum :: Int -> Character -> Int on digitPowerSum(a, c)

   set d to c as integer
   
   a + (d ^ d)

end digitPowerSum

-- GENERIC LIBRARY FUNCTIONS

-- filter :: (a -> Bool) -> [a] -> [a] on filter(f, xs)

   set mf to mReturn(f)
   
   set lst to {}
   set lng to length of xs
   repeat with i from 1 to lng
       set v to item i of xs
       if mf's lambda(v, i, xs) then
           set end of lst to v
       end if
   end repeat
   return lst

end filter

-- foldl :: (a -> b -> a) -> a -> [b] -> a on foldl(f, startValue, xs)

   set mf to mReturn(f)
   
   set v to startValue
   set lng to length of xs
   repeat with i from 1 to lng
       set v to mf's lambda(v, item i of xs, i, xs)
   end repeat
   return v

end foldl

-- range :: Int -> Int -> [Int] on range(m, n)

   if n < m then
       set d to -1
   else
       set d to 1
   end if
   set lst to {}
   repeat with i from m to n by d
       set end of lst to i
   end repeat
   return lst

end range

-- Lift 2nd class handler function into 1st class script wrapper -- mReturn :: Handler -> Script on mReturn(f)

   if class of f is script then return f
   script
       property lambda : f
   end script

end mReturn </lang>

Output:

<lang AppleScript>{1, 3435}</lang>

C

Adapted from Zack Denton's code posted on Munchausen Numbers and How to Find Them. <lang C>#include <stdio.h>

1. include <math.h>

int main() {

   for (int i = 1; i < 5000; i++) {
       // loop through each digit in i
       // e.g. for 1000 we get 0, 0, 0, 1.
       int sum = 0;
       for (int number = i; number > 0; number /= 10) {
           int digit = number % 10;
           // find the sum of the digits 
           // raised to themselves 
           sum += pow(digit, digit);
       }
       if (sum == i) {
           // the sum is equal to the number
           // itself; thus it is a 
           // munchausen number
           printf("%i\n", i);
       } 
   }
   return 0;

}</lang>

Output:

1
3435

C#

<lang csharp>Func<char, int> toInt = c => c-'0';

foreach (var i in Enumerable.Range(1,5000) .Where(n => n == n.ToString() .Sum(x => Math.Pow(toInt(x), toInt(x))))) Console.WriteLine(i);</lang>

Output:

1
3435

Haskell

<lang haskell>import Data.List (unfoldr)

isMunchausen :: Integer -> Bool isMunchausen n = (n ==) $ sum $ map (\x -> x^x) $ unfoldr digit n where

 digit 0 = Nothing
 digit n = Just (r,q) where (q,r) = n `divMod` 10

main :: IO () main = print $ filter isMunchausen [1..5000]</lang>

Output:

[1,3435]

J

Here, it would be useful to have a function which sums the powers of the digits of a number. Once we have that we can use it with an equality test to filter those integers:

<lang J> munch=: +/@(^~@(10&#.inv))

  (#~ ] = munch"0) 1+i.5000

1 3435</lang>

Note that wikipedia claims that 0=0^0 in the context of Munchausen numbers. It's not clear why this should be (1 is the multiplicative identity and if you do not multiply it by zero it should still be 1), but it's easy enough to implement. Note also that this does not change the result for this task:

<lang J> munch=: +/@((**^~)@(10&#.inv))

  (#~ ] = munch"0) 1+i.5000

1 3435</lang>

Java

Adapted from Zack Denton's code posted on Munchausen Numbers and How to Find Them. <lang Java> public class Main {

   public static void main(String[] args) {
       for(int i = 0 ; i <= 5000 ; i++ ){
           int val = String.valueOf(i).chars().map(x -> (int) Math.pow( x-48 ,x-48)).sum();
           if( i == val){
               System.out.println( i + " (munchausen)");
           }
       }
   }

}

</lang>

Output:

1 (munchausen)
3435 (munchausen)

JavaScript

ES6

<lang javascript>for (let i of [...Array(5000).keys()] .filter(n => n == n.toString().split() .reduce((a, b) => a+Math.pow(parseInt(b),parseInt(b)), 0))) console.log(i);</lang>

Output:

1
3435

Or, composing reusable primitives:

<lang JavaScript>(function () {

   'use strict';

   // isMunchausen :: Int -> Bool
   let isMunchausen = n =>
           !isNaN(n) && (
               n.toString()
               .split()
               .reduce((a, c) => {
                   let d = parseInt(c, 10);
   
                   return a + Math.pow(d, d);
               }, 0) === n
           ),

       // range(intFrom, intTo, intStep?)
       // Int -> Int -> Maybe Int -> [Int]
       range = (m, n, step) => {
           let d = (step || 1) * (n >= m ? 1 : -1);

           return Array.from({
               length: Math.floor((n - m) / d) + 1
           }, (_, i) => m + (i * d));
       };

   return range(1, 5000)
       .filter(isMunchausen);

})();</lang>

Output:

<lang JavaScript>[1, 3435]</lang>

Lua

<lang Lua>function isMunchausen (n)

   local sum, nStr, digit = 0, tostring(n)
   for pos = 1, #nStr do
       digit = tonumber(nStr:sub(pos, pos))
       sum = sum + digit ^ digit
   end
   return sum == n

end

for i = 1, 5000 do

   if isMunchausen(i) then print(i) end

end</lang>

Output:

1
3435

Pascal

Works with: Free Pascal

Works with: Delphi

tried to speed things up.Only checking one arrangement of 123456789 instead of all 9! = 362880 permutations. This ist possible, because summing up is commutative.So I only need to check, that the number and the sum of power of digits have the same amount in every possible digit. This means, that a permutation of the digits of number leads to the sum of power of digits. Therefore I need leading zero's. <lang pascal>{$IFDEF FPC}{$MODE objFPC}{$ELSE}{$APPTYPE CONSOLE}{$ENDIF} uses

 sysutils;

type

 tdigit  = byte;

const

 base = 10;
 maxDigits = base-1;// set for 32-compilation otherwise overflow.

var

 DgtPotDgt : array[0..base-1] of NativeUint;
 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 > 1 then
 Begin
   For i := minDigit to base-1 do
     Munch(number+i,DgtPowSum+DgtPotDgt[i],i,digits-1);
 end
 else
   For i := minDigit to base-1 do    
     //number is always the arrangement of the digits leading to smallest number 
     IF (number+i)<= (DgtPowSum+DgtPotDgt[i]) then 
       IF CheckSameDigits(number+i,DgtPowSum+DgtPotDgt[i]) then
         iF number+i>0 then
           writeln(Format('%*d  %.*d',
            [maxDigits,DgtPowSum+DgtPotDgt[i],maxDigits,number+i]));

end;

procedure InitDgtPotDgt; 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

 cnt := 0;
 InitDgtPotDgt;
 Munch(0,0,0,maxDigits);    
 writeln('Check Count ',cnt);

end. </lang>

Output:

         1  000000001
      3435  000003345
 438579088  034578889
Check Count 43758

real    0m0.002s

Perl 6

<lang perl6>sub is_munchausen ( Int $n ) {

   constant @powers = 0, |map { $_ ** $_ }, 1..9;
   $n == @powers[$n.comb].sum;

} .say if .&is_munchausen for 1..5000;</lang>

Output:

1
3435

REXX

<lang rexx>Do n=0 To 10000

 If n=m(n) Then
   Say n
 End

Exit m: Parse Arg z res=0 Do While z>

 Parse Var z c +1 z
 res=res+c**c
 End

Return res</lang>

Output:

D:\mau>rexx munch
1
3435

Scala

Adapted from Zack Denton's code posted on Munchausen Numbers and How to Find Them. <lang Scala> object Munch {

 def main(args: Array[String]): Unit = {
   import scala.math.pow
   (1 to 5000).foreach {
     i => if (i == (i.toString.toCharArray.map(d => pow(d.asDigit,d.asDigit))).sum)
       println( i + " (munchausen)")
   }
 }

} </lang>

Output:

1 (munchausen)
3435 (munchausen)

Sidef

<lang ruby>func is_munchausen(n) {

   n.digits.map{|d| d**d }.sum == n

}

say (1..5000 -> grep(is_munchausen))</lang>

Output:

[1, 3435]

zkl

<lang zkl>[1..5000].filter(fcn(n){ n==n.split().reduce(fcn(s,n){ s + n.pow(n) },0) }) .println();</lang>

Output:

L(1,3435)