Munchausen numbers

From Rosetta Code
Task
Munchausen numbers
You are encouraged to solve this task according to the task description, using any language you may know.

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.

(Munchausen is also spelled: Münchhausen.)

For instance:   3435 = 33 + 44 + 33 + 55


Task

Find all Munchausen numbers between   1   and   5000.


Also see



11l

Translation of: Python
L(i) 5000
   I i == sum(String(i).map(x -> Int(x) ^ Int(x)))
      print(i)
Output:
1
3435

360 Assembly

*        Munchausen numbers        16/03/2019
MUNCHAU  CSECT
         USING  MUNCHAU,R12        base register
         LR     R12,R15            set addressability
         L      R3,=F'5000'        for do i=1 to 5000
         LA     R6,1               i=1
LOOPI    SR     R10,R10              s=0
         LR     R0,R6                ii=i
         LA     R11,4                for do j=1 to 4
         LA     R7,P10               j=1
LOOPJ    L      R8,0(R7)               d=p10(j)
         LR     R4,R0                  ii
         SRDA   R4,32                  ~
         DR     R4,R8                  (n,r)=ii/d
         SLA    R5,2                   ~
         L      R1,POW(R5)             pow(n+1)
         AR     R10,R1                 s=s+pow(n+1)
         LR     R0,R4                  ii=r
         LA     R7,4(R7)               j++
         BCT    R11,LOOPJ            enddo j
         CR     R10,R6               if s=i
         BNE    SKIP                 then
         XDECO  R6,PG                  edit i
         XPRNT  PG,L'PG                print i
SKIP     LA     R6,1(R6)             i++
         BCT    R3,LOOPI           enddo i
         BR     R14                return to caller
POW      DC     F'0',F'1',F'4',F'27',F'256',F'3125',4F'0'
P10      DC     F'1000',F'100',F'10',F'1'
PG       DC     CL12' '            buffer
         REGEQU
         END    MUNCHAU
Output:
           1
        3435

8080 Assembly

putch:	equ	2	; CP/M syscall to print character
puts:	equ	9	; CP/M syscall to print string
	org	100h
	lxi	b,0500h	; B C D E hold 4 digits of number
	lxi	d,0000h	; we work backwards from 5000
	lxi	h,-5000	; HL holds negative binary representation of number
test:	push	h	; Keep current number
	push	d	; Keep last two digits (to use DE as scratch register)
	push	h 	; Keep current number (to test against)
	lxi	h,0	; Digit power sum = 0
	mov	a,b	
	call	addap
	mov	a,c
	call	addap
	mov	a,d
	call 	addap
	mov	a,e
	call 	addap
	xra	a	; Correct for leading zeroes
	ora	b
	jnz	calc
	dcx	h
	ora	c
	jnz	calc
	dcx	h
	ora	d
	jnz 	calc
	dcx	h
calc:	pop	d	; Load current number (as negative) into DE
	dad	d 	; Add to sum of digits (if equal, should be 0)
	mov	a,h	; See if they are equal
	ora	l
	pop	d	; Restore last two digits
	pop	h	; Restore current number
	jnz	next	; If not equal, this is not a Munchhausen number
	mov	a,b	; Otherwise, print the number
	call	pdgt
	mov	a,c
	call	pdgt
	mov	a,d
	call	pdgt
	mov	a,e
	call	pdgt
	call	pnl
next:	inx	h	; Increment negative binary representation
	mvi	a,5
	dcr	e	; Decrement last digit
	jp	test	; If not negative, try next number
	mov	e,a	; Otherwise, set to 5,
	inx	h	; Add 4 extra to HL,
	inx	h
	inx	h
	inx	h 
	dcr	d
	jp	test
	mov	d,a
	push	d	; Add 40 extra to HL,
	lxi	d,40
	dad	d
	pop	d
	dcr 	c
	jp	test
	mov	c,a
	push	d	; Add 400 extra to HL,
	lxi	d,400
	dad	d
	pop	d
	dcr	b
	jp	test
	ret		; When B<0, we're done
	;;;	Print A as digit
pdgt:	adi	'0'
	push	b	; Save all registers (CP/M tramples them)
	push	d
	push	h
	mov	e,a	; Print character
	mvi	c,putch
	call	5
restor:	pop	h	; Restore registers
	pop	d
	pop 	b
	ret
	;;;	Print newline
pnl:	push	b	; Save all registers
	push	d
	push	h
	lxi	d,nl	; Print newline
	mvi	c,puts
	call	5
	jmp	restor	; Restore registers
nl:	db	13,10,'$'	
	;;;	Add A^A to HL
addap:	push	d	; Keep DE
	push	h	; Keep HL
	add	a	; A *= 2 (entries are 2 bytes wide)
	mvi	d,0	; DE = lookup table index
	mov	e,a 	
	lxi	h,dpow	; Calculate table address
	dad	d
	mov	e,m	; Load low byte into E
	inx	h
	mov	d,m	; Load high byte into D
	pop	h	; Retrieve old HL
	dad	d	; Add power
	pop	d	; Restore DE
	ret	
dpow:	dw	1,1,4,27,256,3125	; 0^0 to 5^5 lookup table
Output:
3435
0001

Action!

;there are considered digits 0-5 because 6^6>5000
DEFINE MAXDIGIT="5"
INT ARRAY powers(MAXDIGIT+1)

INT FUNC Power(BYTE x)
  INT res
  BYTE i

  IF x=0 THEN RETURN (0) FI
  res=1
  FOR i=0 TO x-1
  DO
    res==*x
  OD
RETURN (res)

BYTE FUNC IsMunchausen(INT x)
  INT sum,tmp
  BYTE d

  tmp=x sum=0
  WHILE tmp#0
  DO
    d=tmp MOD 10
    IF d>MAXDIGIT THEN
      RETURN (0)
    FI
    sum==+powers(d)
    tmp==/10
  OD
  IF sum=x THEN
    RETURN (1)
  FI
RETURN (0)

PROC Main()
  INT i

  FOR i=0 TO MAXDIGIT
  DO
    powers(i)=Power(i)
  OD
  FOR i=1 TO 5000
  DO
    IF IsMunchausen(i) THEN
      PrintIE(i)
    FI
  OD  
RETURN
Output:

Screenshot from Atari 8-bit computer

1
3435

Ada

with Ada.Text_IO;

procedure Munchausen is

   function Is_Munchausen (M : in Natural) return Boolean is
      Table : constant array (Character range '0' .. '9') of Natural :=
        (0**0, 1**1, 2**2, 3**3, 4**4,
         5**5, 6**6, 7**7, 8**8, 9**9);
      Image : constant String := M'Image;
      Sum   : Natural := 0;
   begin
      for I in Image'First + 1 .. Image'Last loop
         Sum := Sum + Table (Image (I));
      end loop;
      return Image = Sum'Image;
   end Is_Munchausen;

begin
   for M in 1 .. 5_000 loop
      if Is_Munchausen (M) then
         Ada.Text_IO.Put (M'Image);
      end if;
   end loop;
   Ada.Text_IO.New_Line;
end Munchausen;
Output:
 1 3435

ALGOL 68

# Find Munchausen Numbers between 1 and 5000                                        #
# note that 6^6 is 46 656 so we only need to consider numbers consisting of 0 to 5   #
 
# 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
Output:
1
3435

Alternative that finds all 4 Munchausen numbers. As noted by the Pascal sample, we only need to consider one arrangement of the digits of each number (e.g. we only need to consider 3345, not 3435, 3453, etc.). This also relies on the non-standard 0^0 = 0.

# Find all Munchausen numbers - note 11*(9^9) has only 10 digits so there are no    #
# Munchausen numbers with 11+ digits                                                #
# table of Nth powers - note 0^0 is 0 for Munchausen numbers, not 1                 #
[]INT nth power = ([]INT( 0, 1, 2 ^ 2, 3 ^ 3, 4 ^ 4, 5 ^ 5, 6 ^ 6, 7 ^ 7, 8 ^ 8, 9 ^ 9 ) )[ AT 0 ];

[       ]INT z count  = []INT( ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ) )[ AT 0 ];
[ 0 : 9 ]INT d count := z count;

# as the digit power sum is independent of the order of the digits, we need only    #
# consider one arrangement of each possible combination of digits                   #
FOR d1 FROM 0 TO 9 DO
    FOR d2 FROM 0 TO d1 DO
        FOR d3 FROM 0 TO d2 DO
            FOR d4 FROM 0 TO d3 DO
                FOR d5 FROM 0 TO d4 DO
                    FOR d6 FROM 0 TO d5 DO
                        FOR d7 FROM 0 TO d6 DO
                            FOR d8 FROM 0 TO d7 DO
                                FOR d9 FROM 0 TO d8 DO
                                    FOR da FROM 0 TO d9 DO
                                        LONG INT digit power sum  := nth power[ d1 ] + nth power[ d2 ];
                                        digit power sum          +:= nth power[ d3 ] + nth power[ d4 ];
                                        digit power sum          +:= nth power[ d5 ] + nth power[ d6 ];
                                        digit power sum          +:= nth power[ d7 ] + nth power[ d8 ];
                                        digit power sum          +:= nth power[ d9 ] + nth power[ da ];
                                        # count the occurrences of each digit (including leading zeros #
                                        d count        := z count;
                                        d count[ d1 ] +:= 1; d count[ d2 ] +:= 1; d count[ d3 ] +:= 1;
                                        d count[ d4 ] +:= 1; d count[ d5 ] +:= 1; d count[ d6 ] +:= 1;
                                        d count[ d7 ] +:= 1; d count[ d8 ] +:= 1; d count[ d9 ] +:= 1;
                                        d count[ da ] +:= 1;
                                        # subtract the occurrences of each digit in the power sum      #
                                        # (also including leading zeros) - if all counts drop to 0 we  #
                                        # have a Munchausen number                                     #
                                        LONG INT number        := digit power sum;
                                        INT      leading zeros := 10;
                                        WHILE number > 0 DO
                                            d count[ SHORTEN ( number MOD 10 ) ] -:= 1;
                                            leading zeros -:= 1;
                                            number OVERAB 10
                                        OD;
                                        d count[ 0 ] -:= leading zeros;
                                        IF  d count[ 0 ] = 0 AND d count[ 1 ] = 0 AND d count[ 2 ] = 0
                                        AND d count[ 3 ] = 0 AND d count[ 4 ] = 0 AND d count[ 5 ] = 0
                                        AND d count[ 6 ] = 0 AND d count[ 7 ] = 0 AND d count[ 8 ] = 0
                                        AND d count[ 9 ] = 0
                                        THEN
                                            print( ( digit power sum, newline ) )
                                        FI
                                    OD
                                OD
                            OD
                        OD
                    OD
                OD
            OD
        OD
    OD
OD
Output:
                                  +0
                                  +1
                               +3435
                          +438579088

ALGOL W

Translation of: ALGOL 68
% Find Munchausen Numbers between 1 and 5000                                         %
% note that 6^6 is 46 656 so we only need to consider numbers consisting of 0 to 5   %
begin
 
    % table of nth Powers - note 0^0 is 0 for Munchausen numbers, not 1              %
    integer array nthPower( 0 :: 5 );
    integer d1, d2, d3, d4, d1Part, d2Part, d3Part;
    nthPower( 0 ) := 0;             nthPower( 1 ) := 1;
    nthPower( 2 ) := 2 * 2;         nthPower( 3 ) := 3 * 3 * 3;
    nthPower( 4 ) := 4 * 4 * 4 * 4; nthPower( 5 ) := 5 * 5 * 5 * 5 * 5;
    d1 := d2 := d3 := d1Part := d2Part := d3Part := 0;
    d4 := 1;
    while d1 < 6 do begin
        integer number, digitPowerSum;
        number        := d1Part + d2Part + d3Part + d4;
        digitPowerSum := nthPower( d1 )
                       + nthPower( d2 )
                       + nthPower( d3 )
                       + nthPower( d4 );
        if digitPowerSum = number then begin
            write( i_w := 1, number )
        end;
        d4 := d4 + 1;
        if d4 > 5 then begin
            d4     := 0;
            d3     := d3 + 1;
            d3Part := d3Part + 10;
            if d3 > 5 then begin
                d3     := 0;
                d3Part := 0;
                d2     := d2 + 1;
                d2Part := d2Part + 100;
                if d2 > 5 then begin
                    d2     := 0;
                    d2Part := 0;
                    d1     := d1 + 1;
                    d1Part := d1Part + 1000;
                end
            end
        end
    end

end.
Output:
1
3435

APL

Works with: Dyalog APL
((/⍨)⊢=+/∘(*⍨∘¨)¨) 5000
Output:
1 3435

AppleScript

Functional

------------------- MUNCHAUSEN NUMBER ? --------------------

-- isMunchausen :: Int -> Bool
on isMunchausen(n)
    
    -- digitPowerSum :: Int -> Character -> Int
    script digitPowerSum
        on |λ|(a, c)
            set d to c as integer
            a + (d ^ d)
        end |λ|
    end script
    
    (class of n is integer) and ¬
        n = foldl(digitPowerSum, 0, characters of (n as string))
    
end isMunchausen


--------------------------- TEST ---------------------------
on run
    
    filter(isMunchausen, enumFromTo(1, 5000))
    
    --> {1, 3435}
    
end run


-------------------- GENERIC FUNCTIONS ---------------------

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if m  n then
        set lst to {}
        repeat with i from m to n
            set end of lst to i
        end repeat
        lst
    else
        {}
    end if
end enumFromTo

-- filter :: (a -> Bool) -> [a] -> [a]
on filter(p, xs)
    tell mReturn(p)
        set lst to {}
        set lng to length of xs
        repeat with i from 1 to lng
            set v to item i of xs
            if |λ|(v, i, xs) then set end of lst to v
        end repeat
        return lst
    end tell
end filter

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- Lift 2nd class handler function into 1st class script wrapper 
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn
Output:
{1, 3435}

Iterative

More straightforwardly:

set MunchhausenNumbers to {}
repeat with i from 1 to 5000
    if (i > 0) then
        set n to i
        set s to 0
        repeat until (n is 0)
            tell n mod 10 to set s to s + it ^ it
            set n to n div 10
        end repeat
        if (s = i) then set end of MunchhausenNumbers to i
    end if
end repeat

return MunchhausenNumbers
Output:
{1, 3435}

Arturo

munchausen?: function [n][
    n = sum map split to :string n 'digit [
        d: to :integer digit
        d^d
    ]
]

loop 1..5000 'x [
    if munchausen? x ->
        print x
]
Output:
1
3435

AutoHotkey

Loop, 5000
{
	Loop, Parse, A_Index
		var += A_LoopField**A_LoopField
	if (var = A_Index)
		num .= var "`n"
	var := 0
}
Msgbox, %num%
Output:
1
3435

AWK

# syntax: GAWK -f MUNCHAUSEN_NUMBERS.AWK
BEGIN {
    for (i=1; i<=5000; i++) {
      sum = 0
      for (j=1; j<=length(i); j++) {
        digit = substr(i,j,1)
        sum += digit ^ digit
      }
      if (i == sum) {
        printf("%d\n",i)
      }
    }
    exit(0)
}
Output:
1
3435

BASIC

This should need only minimal modification to work with any old-style BASIC that supports user-defined functions. The call to INT in line 10 is needed because the exponentiation operator may return a (floating-point) value that is slightly too large.

10 DEF FN P(X)=INT(X^X*SGN(X))
20 FOR I=0 TO 5
30 FOR J=0 TO 5
40 FOR K=0 TO 5
50 FOR L=0 TO 5
60 M=FN P(I)+FN P(J)+FN P(K)+FN P(L)
70 N=1000*I+100*J+10*K+L
80 IF M=N AND M>0 THEN PRINT M
90 NEXT L
100 NEXT K
110 NEXT J
120 NEXT I
Output:
 1
 3435

Sinclair ZX81 BASIC

Works with 1k of RAM. The word FAST in line 10 shouldn't be taken too literally. We don't have DEF FN, so the expression for exponentiation-where-zero-to-the-power-zero-equals-zero is written out inline.

 10 FAST
 20 FOR I=0 TO 5
 30 FOR J=0 TO 5
 40 FOR K=0 TO 5
 50 FOR L=0 TO 5
 60 LET M=INT (I**I*SGN I+J**J*SGN J+K**K*SGN K+L**L*SGN L)
 70 LET N=1000*I+100*J+10*K+L
 80 IF M=N AND M>0 THEN PRINT M
 90 NEXT L
100 NEXT K
110 NEXT J
120 NEXT I
130 SLOW
Output:
1
3435

BBC BASIC

REM >munchausen
FOR i% = 0 TO 5
  FOR j% = 0 TO 5
    FOR k% = 0 TO 5
      FOR l% = 0 TO 5
        m% = FNexp(i%) + FNexp(j%) + FNexp(k%) + FNexp(l%)
        n% = 1000 * i% + 100 * j% + 10 * k% + l%
        IF m% = n% AND m% > 0 THEN PRINT m%
      NEXT
    NEXT
  NEXT
NEXT
END
:
DEF FNexp(x%)
IF x% = 0 THEN
  = 0
ELSE
  = x% ^ x%
Output:
         1
      3435

BQN

Dgts  •Fmt-'0'˙
IsMnch  ⊢=+´(˜ Dgts)
IsMnch¨/ 1+↕5000
Output:
⟨ 1 3435 ⟩

C

Adapted from Zack Denton's code posted on Munchausen Numbers and How to Find Them.

#include <stdio.h>
#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;
}
Output:
1
3435

C#

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);
Output:
1
3435

Faster version

Translation of: Kotlin
using System;

namespace Munchhausen
{
    class Program
    {
        static readonly long[] cache = new long[10];

        static void Main()
        {
            // Allow for 0 ^ 0 to be 0
            for (int i = 1; i < 10; i++)
            {
                cache[i] = (long)Math.Pow(i, i);
            }

            for (long i = 0L; i <= 500_000_000L; i++)
            {
                if (IsMunchhausen(i))
                {
                    Console.WriteLine(i);
                }
            }
            Console.ReadLine();
        }

        private static bool IsMunchhausen(long n)
        {
            long sum = 0, nn = n;
            do
            {
                sum += cache[(int)(nn % 10)];
                if (sum > n)
                {
                    return false;
                }
                nn /= 10;
            } while (nn > 0);

            return sum == n;
        }
    }
}
0
1
3435
438579088

Faster version alternate

Translation of: Visual Basic .NET

Search covers all 11 digit numbers (as pointed out elsewhere, 11*(9^9) has only 10 digits, so there are no Munchausen numbers with 11+ digits), not just the first half of the 9 digit numbers. Computation time is under 1.5 seconds.

using System;

static class Program
{
    public static void Main()
    {
        long sum, ten1 = 0, ten2 = 10; byte [] num; int [] pow = new int[10];
        int i, j, n, n1, n2, n3, n4, n5, n6, n7, n8, n9, s2, s3, s4, s5, s6, s7, s8;
        for (i = 1; i <= 9; i++) { pow[i] = i; for (j = 2; j <= i; j++) pow[i] *= i; }
        for (n = 1; n <= 11; n++) { for (n9 = 0; n9 <= n; n9++) { for (n8 = 0; n8 <= n - n9; n8++) {
              for (n7 = 0; n7 <= n - (s8 = n9 + n8); n7++) { for (n6 = 0; n6 <= n - (s7 = s8 + n7); n6++) {
                  for (n5 = 0; n5 <= n - (s6 = s7 + n6); n5++) { for (n4 = 0; n4 <= n - (s5 = s6 + n5); n4++) {
                      for (n3 = 0; n3 <= n - (s4 = s5 + n4); n3++) { for (n2 = 0; n2 <= n - (s3 = s4 + n3); n2++) {
                          for (n1 = 0; n1 <= n - (s2 = s3 + n2); n1++) {
                            sum = n1 * pow[1] + n2 * pow[2] + n3 * pow[3] + n4 * pow[4] + 
                                  n5 * pow[5] + n6 * pow[6] + n7 * pow[7] + n8 * pow[8] + n9 * pow[9];
                            if (sum < ten1 || sum >= ten2) continue;
                            num = new byte[10]; foreach (char ch in sum.ToString()) num[Convert.ToByte(ch) - 48] += 1;
                            if (n - (s2 + n1) == num[0] && n1 == num[1] && n2 == num[2]
                              && n3 == num[3] && n4 == num[4] && n5 == num[5] && n6 == num[6]
                              && n7 == num[7] && n8 == num[8] && n9 == num[9]) Console.WriteLine(sum);
                          } } } } } } } } }
          ten1 = ten2; ten2 *= 10;
        }
    }
}
Output:
0
1
3435
438579088

C++

#include <math.h>
#include <iostream>

unsigned pwr[10];

unsigned munch( unsigned i ) {
    unsigned sum = 0;
    while( i ) {
        sum += pwr[(i % 10)];
        i /= 10;
    }
    return sum;
}

int main( int argc, char* argv[] ) {
    for( int i = 0; i < 10; i++ )
        pwr[i] = (unsigned)pow( (float)i, (float)i );
    std::cout << "Munchausen Numbers\n==================\n";
    for( unsigned i = 1; i < 5000; i++ )
        if( i == munch( i ) ) std::cout << i << "\n";
    return 0;
}
Output:
Munchausen Numbers
==================
1
3435

Clojure

(ns async-example.core
  (:require [clojure.math.numeric-tower :as math])
  (:use [criterium.core])
  (:gen-class))

(defn get-digits [n]
  " Convert number of a list of digits  (e.g. 545 -> ((5), (4), (5)) "
  (map #(Integer/valueOf (str %)) (String/valueOf n)))

(defn sum-power [digits]
  " Convert digits such as abc... to a^a + b^b + c^c ..."
  (let [digits-pwr (fn [n]
                     (apply + (map #(math/expt % %) digits)))]
    (digits-pwr digits)))

(defn find-numbers [max-range]
  " Filters for Munchausen numbers "
  (->>
    (range 1 (inc max-range))
    (filter #(= (sum-power (get-digits %)) %))))


(println (find-numbers 5000))
Output:
(1 3435)

CLU

digits = iter (n: int) yields (int)
    while n>0 do
        yield(n//10)
        n := n/10
    end
end digits

munchausen = proc (n: int) returns (bool)
    k: int := 0
    for d: int in digits(n) do
        % Note: 0^0 is to be regarded as 0
        if d~=0 then k := k + d ** d end 
    end
    return(n = k)
end munchausen

start_up = proc ()
    po: stream := stream$primary_output()
    for i: int in int$from_to(1,5000) do
        if munchausen(i) then stream$putl(po, int$unparse(i)) end
    end
end start_up
Output:
1
3435

Common Lisp

;;; check4munch maximum &optional b
;;; Return a list with all Munchausen numbers less then or equal to maximum.
;;; Checks are done in base b (<=10, dpower is the limiting factor here).
(defun check4munch (maximum &optional (base 10))
  (do ((n 1 (1+ n))
       (result NIL (if (munchp n base) (cons n result) result)))
      ((> n maximum)
       (nreverse result))))

;;;
;;; munchp n &optional b
;;; Return T if n is a Munchausen number in base b.
(defun munchp (n &optional (base 10))
   (if (= n (apply #'+ (mapcar #'dpower (n2base n base)))) T NIL))

;;; dpower d
;;; Returns d^d. I.e. the digit to the power of itself.
;;; 0^0 is set to 0. For discussion see e.g. the wikipedia entry.
;;; This function is mainly performance optimization.
(defun dpower (d)
  (aref #(0 1 4 27 256 3125 45556 823543 16777216 387420489) d))

;;; divmod a b
;;; Return (q,k) such that a = b*q + k and k>=0.
(defun divmod (a b)
  (let ((foo (mod a b)))
    (list (/ (- a foo) b) foo)))

;;; n2base n &optional b
;;; Return a list with the digits of n in base b representation.
(defun n2base (n &optional (base 10) (digits NIL))
  (if (zerop n) digits
                (let ((dm (divmod n base)))
                  (n2base (car dm) base (cons (cadr dm) digits)))))
Output:
> (check4munch 5000)
(1 3435)
> (munchp 438579088)
T

COBOL

       IDENTIFICATION DIVISION.
       PROGRAM-ID.  MUNCHAUSEN.
 
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 VARIABLES.
          03 CANDIDATE   PIC 9(4).
          03 DIGITS      PIC 9 OCCURS 4 TIMES, REDEFINES CANDIDATE.
          03 DIGIT       PIC 9.
          03 POWER-SUM   PIC 9(5).

       01 OUTPUT-LINE.
          03 OUT-NUM     PIC ZZZ9.

       PROCEDURE DIVISION.
       BEGIN.
           PERFORM MUNCHAUSEN-TEST VARYING CANDIDATE FROM 1 BY 1
               UNTIL CANDIDATE IS GREATER THAN 6000.
           STOP RUN.

       MUNCHAUSEN-TEST.
           MOVE ZERO TO POWER-SUM.
           MOVE 1 TO DIGIT.
           INSPECT CANDIDATE TALLYING DIGIT FOR LEADING '0'.
           PERFORM ADD-DIGIT-POWER VARYING DIGIT FROM DIGIT BY 1
               UNTIL DIGIT IS GREATER THAN 4.
           IF POWER-SUM IS EQUAL TO CANDIDATE,
               MOVE CANDIDATE TO OUT-NUM,
               DISPLAY OUTPUT-LINE.
        
       ADD-DIGIT-POWER.
           COMPUTE POWER-SUM = 
                     POWER-SUM + DIGITS(DIGIT) ** DIGITS(DIGIT)
Output:
   1
3435

Cowgol

include "cowgol.coh";

sub digitPowerSum(n: uint16): (sum: uint32) is
    var powers: uint32[10] := 
        {1, 1, 4, 27, 256, 3125, 46656, 823543, 16777216, 387420489};
        
    sum := 0;
    loop
        sum := sum + powers[(n % 10) as uint8];
        n := n / 10;
        if n == 0 then break; end if;
    end loop;
end sub;

var n: uint16 := 1;
while n < 5000 loop
    if n as uint32 == digitPowerSum(n) then
        print_i16(n);
        print_nl();
    end if;
    n := n + 1;
end loop;
Output:
1
3435

Craft Basic

for i = 0 to 5

	for j = 0 to 5

		for k = 0 to 5

			for l = 0 to 5

				let m = int(i ^ i * sgn(i))
				let m = m + int(j ^ j * sgn(j))
				let m = m + int(k ^ k * sgn(k))
				let m = m + int(l ^ l * sgn(l))

				let n = 1000 * i + 100 * j + 10 * k + l

				if m = n and m > 0 then

					print m

				endif

				wait

			next l

		next k

	next j

next i
Output:
1
3435

D

Translation of: C
import std.stdio;

void 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 += digit ^^ digit;
        }
        if (sum == i) {
            // the sum is equal to the number
            // itself; thus it is a
            // munchausen number
            writeln(i);
        } 
    }
}
Output:
1
3435

Dc

Needs a modern Dc due to ~. Use S1S2l2l1/L2L1% instead of ~ to run it in older Dcs.

[ O ~ S! d 0!=M L! d ^ + ] sM
[p] sp
[z d d lM x =p z 5001>L ] sL
lL x

Cosmetic: The stack is dirty after execution. The loop L needs a fix if that is a problem.

Delphi

See Pascal.

EasyLang

for i = 1 to 5000
   sum = 0
   n = i
   while n > 0
      dig = n mod 10
      sum += pow dig dig
      n = n div 10
   .
   if sum = i
      print i
   .
.

Elixir

defmodule Munchausen do
  @pow  for i <- 0..9, into: %{}, do: {i, :math.pow(i,i) |> round}
  
  def number?(n) do
    n == Integer.digits(n) |> Enum.reduce(0, fn d,acc -> @pow[d] + acc end)
  end
end

Enum.each(1..5000, fn i ->
  if Munchausen.number?(i), do: IO.puts i
end)
Output:
1
3435

F#

let toFloat x = x |> int |> fun n -> n - 48 |> float
let power x = toFloat x ** toFloat x |> int
let isMunchausen n = n = (string n |> Seq.map char |> Seq.map power |> Seq.sum)

printfn "%A" ([1..5000] |> List.filter isMunchausen)
Output:
[1; 3435]

Factor

USING: kernel math.functions math.ranges math.text.utils
prettyprint sequences ;

: munchausen? ( n -- ? )
    dup 1 digit-groups dup [ ^ ] 2map sum = ;

5000 [1,b] [ munchausen? ] filter .
Output:
V{ 1 3435 }

FALSE

0[1+$5000>~][
    $$0\[$][
        $10/$@\10*-
        $0>[
            $$[1-$][\2O*\]#
            %\%
        ]?
        @+\
    ]#
    %=[$.10,]?
]#%
Output:
1
3435

FOCAL

01.10 F N=1,5000;D 2

02.10 S M=N;S S=0
02.20 S D=M-FITR(M/10)*10
02.25 S S=S+D^D
02.30 S M=FITR(M/10)
02.40 I (M),2.5,2.2
02.50 I (N-S)2.7,2.6,2.7
02.60 T %4,N,!
02.70 R
Output:
=    1
= 3435

Forth

Works with: GNU Forth version 0.7.0
 : dig.num                                       \ returns input number and the number of its digits ( n -- n n1 )
	 dup
	 0 swap
     begin
	 swap 1 + swap
	 dup 10 >= while
	 10 /
     repeat
	 drop ;
	
 : to.self                                        \ returns input number raised to the power of itself ( n -- n^n  )
	 dup 1 = if drop 1 else                   \ positive numbers only, zero and negative returns zero
	 dup 0 <= if drop 0 else
	 dup
         1 do 
	 dup 
	 loop
	 dup
	 1 do 
	 *
         loop
	 then then ;

 : ten.to			                    \ ( n -- 10^n ) returns 1 for zero and negative
	 dup 0 <= if drop 1 else
	 dup 1 = if drop 10 else
	 10 swap
         1 do 
	 10 *
         loop then then ;
	
 : zero.divmod                                       \ /mod that returns zero if number is zero
	  dup
	  0 = if drop 0 
          else /mod 
	  then ;
	
 : split.div                                         \ returns input number and its digits ( n -- n n1 n2 n3....)
	  dup 10 < if dup 0 else		     \ duplicates single digit numbers adds 0 for add.pow
	  dig.num			             \ provides number of digits
	  swap dup rot dup 1 - ten.to swap           \ stack juggling, ten raised to number of digits - 1...
          1 do                                       \ ... is the needed divisor, counter on top and ...
	  dup rot swap zero.divmod swap rot 10 /     \ ...division loop
          loop drop then ;
	
 : add.pow	  				     \ raises each number on the stack except last one to ...
	  to.self                                    \ ...the power of itself and adds them
	  depth					     \ needs at least 3 numbers on the stack
          2 do 
	  swap to.self +
          loop ; 

 : check.num                                 
	 split.div add.pow ;
	
 : munch.num                                         \ ( n -- ) displays Munchausen numbers between 1 and n
         1 +
	 page
         1 do 
         i check.num = if i . cr 
         then loop ;
Output:
1
3435
 ok

Fortran

Translation of: 360 Assembly

Fortran IV

C MUNCHAUSEN NUMBERS - FORTRAN IV
      DO 2 I=1,5000
        IS=0
        II=I
        DO 1 J=1,4
          ID=10**(4-J)
          N=II/ID
          IR=MOD(II,ID)
          IF(N.NE.0) IS=IS+N**N
  1       II=IR
  2     IF(IS.EQ.I) WRITE(*,*) I
      END
Output:
           1
        3435

Fortran 77

! MUNCHAUSEN NUMBERS - FORTRAN 77
      DO I=1,5000
        IS=0
        II=I
        DO J=1,4
          ID=10**(4-J)
          N=II/ID
          IR=MOD(II,ID)
          IF(N.NE.0) IS=IS+N**N
          II=IR
        END DO
        IF(IS.EQ.I) WRITE(*,*) I
      END DO
      END
Output:
           1
        3435

FreeBASIC

Version 1

' FB 1.05.0 Win64
' Cache n ^ n for the digits 1 to 9
' Note than 0 ^ 0 specially treated as 0 (not 1) for this purpose
Dim Shared powers(1 To 9) As UInteger
For i As UInteger = 1 To 9 
  Dim power As UInteger = i
  For j As UInteger = 2 To i
     power *= i
  Next j
  powers(i) = power
Next i
 
Function isMunchausen(n As UInteger) As Boolean
  Dim p As UInteger = n
  Dim As UInteger digit, sum
  While p > 0
    digit = p Mod 10
    If digit > 0 Then sum += powers(digit)
    p \= 10
  Wend
  Return n = sum
End Function  
 
Print "The Munchausen numbers between 0 and 500000000 are : "
For i As UInteger = 0 To 500000000
  If isMunchausen(i) Then Print i
Next
 
Print
Print "Press any key to quit"

Sleep
Output:
The Munchausen numbers between 0 and 500000000 are :
0
1
3435
438579088

Version 2

' version 12-10-2017
' compile with: fbc -s console

Dim As UInteger i, j, n, sum, ten1, ten2 = 10
Dim As UInteger n0, n1, n2, n3, n4, n5, n6, n7, n8, n9
Dim As UInteger     s1, s2, s3, s4, s5, s6, s7, s8
Dim As UInteger pow(9), num()
Dim As String number

For i = 1 To 9
  pow(i) = i
  For j = 2 To i
    pow(i) *= i
  Next
Next

For n = 1 To 11
  For n9 = 0 To n
    For n8 = 0 To n - n9
      s8 = n9 + n8
      For n7 = 0 To n - s8
        s7 = s8 + n7
        For n6 = 0 To n - s7
          s6 = s7 + n6
          For n5 = 0 To n - s6
            s5 = s6 + n5
            For n4 = 0 To n - s5
              s4 = s5 + n4
              For n3 = 0 To n - s4
                s3 = s4 + n3
                For n2 = 0 To n - s3
                  s2 = s3 + n2
                  For n1 = 0 To n - s2
                    n0 = n - (s2 + n1)
                    sum = n1 * pow(1) + n2 * pow(2) + n3 * pow(3) + _
                          n4 * pow(4) + n5 * pow(5) + n6 * pow(6) + _
                          n7 * pow(7) + n8 * pow(8) + n9 * pow(9)
                    If sum < ten1 Or sum >= ten2 Then Continue For
                    ReDim num(9) : number = Str(sum)
                    For i = 0 To n -1
                      j = number[i] -48
                      num(j) += 1
                    Next i
                    If n0 = num(0) AndAlso n1 = num(1) AndAlso n2 = num(2) AndAlso _
                       n3 = num(3) AndAlso n4 = num(4) AndAlso n5 = num(5) AndAlso _ 
                       n6 = num(6) AndAlso n7 = num(7) AndAlso n8 = num(8) AndAlso _
                       n9 = num(9) Then Print sum
                  Next n1
                Next n2
              Next n3
            Next n4
          Next n5
        Next n6
      Next n7
    Next n8
  Next n9
  ten1 = ten2
  ten2 *= 10
Next n

' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End
Output:
0
1
3435
438579088

Frink

isMunchausen = { |x|
   sum = 0
   for d = integerDigits[x]
      sum = sum + d^d
   return sum == x
}

println[select[1 to 5000, isMunchausen]]
Output:
[1, 3435]

Fōrmulæ

Fōrmulæ programs are not textual, visualization/edition of programs is done showing/manipulating structures but not text. Moreover, there can be multiple visual representations of the same program. Even though it is possible to have textual representation —i.e. XML, JSON— they are intended for storage and transfer purposes more than visualization and edition.

Programs in Fōrmulæ are created/edited online in its website.

In this page you can see and run the program(s) related to this task and their results. You can also change either the programs or the parameters they are called with, for experimentation, but remember that these programs were created with the main purpose of showing a clear solution of the task, and they generally lack any kind of validation.

Solution

File:Fōrmulæ - Munchausen numbers 01.png

File:Fōrmulæ - Munchausen numbers 02.png

File:Fōrmulæ - Munchausen numbers 03.png

Go

Translation of: Kotlin
package main

import(
    "fmt"
    "math"
)

var powers [10]int

func isMunchausen(n int) bool {
    if n < 0 { return false }
    n64 := int64(n)
    nn  := n64
    var sum int64 = 0
    for nn > 0 {
        sum += int64(powers[nn % 10])
        if sum > n64 { return false }
        nn /= 10
    }
    return sum == n64
}

func main() {
    // cache n ^ n for n in 0..9, defining 0 ^ 0 = 0 for this purpose
    for i := 1; i <= 9; i++ {
        d := float64(i)  
        powers[i] = int(math.Pow(d, d))
    }
 
    // check numbers 0 to 500 million
    fmt.Println("The Munchausen numbers between 0 and 500 million are:")
    for i := 0; i <= 500000000; i++ {
        if isMunchausen(i) { fmt.Printf("%d ", i) }
    }
    fmt.Println()
}
Output:
0 1 3435 438579088 

Haskell

import Control.Monad (join)
import Data.List (unfoldr)

isMunchausen :: Integer -> Bool
isMunchausen =
  (==)
    <*> (sum . map (join (^)) . unfoldr digit)

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

main :: IO ()
main = print $ filter isMunchausen [1 .. 5000]
Output:
[1,3435]

The Haskell libraries provide a lot of flexibility – we could also reduce the sum and map (above) down to a single foldr:

import Data.Char (digitToInt)

isMunchausen :: Int -> Bool
isMunchausen =
  (==)
    <*> foldr ((+) . (id >>=) (^) . digitToInt) 0 . show

main :: IO ()
main = print $ filter isMunchausen [1 .. 5000]

Or, without digitToInt, but importing join, swap and bool.

import Control.Monad (join)
import Data.Bool (bool)
import Data.List (unfoldr)
import Data.Tuple (swap)

isMunchausen :: Integer -> Bool
isMunchausen =
  (==)
    <*> ( foldr ((+) . join (^)) 0
            . unfoldr
              ( ( flip bool Nothing
                    . Just
                    . swap
                    . flip quotRem 10
                )
                  <*> (0 ==)
              )
        )

main :: IO ()
main = print $ filter isMunchausen [1 .. 5000]
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:

   munch=: +/@(^~@(10&#.inv))
   (#~ ] = munch"0) 1+i.5000
1 3435

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:

   munch=: +/@((**^~)@(10&#.inv))
   (#~ ] = munch"0) 1+i.5000
1 3435

Java

Adapted from Zack Denton's code posted on Munchausen Numbers and How to Find Them.

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)");
            }
        }
    }
}
Output:
1 (munchausen)
3435 (munchausen)

Faster version

Translation of: Kotlin
public class Munchhausen {

    static final long[] cache = new long[10];

    public static void main(String[] args) {
        // Allowing 0 ^ 0 to be 0
        for (int i = 1; i < 10; i++) {
            cache[i] = (long) Math.pow(i, i);
        }
        for (long i = 0L; i <= 500_000_000L; i++) {
            if (isMunchhausen(i)) {
                System.out.println(i);
            }
        }
    }

    private static boolean isMunchhausen(long n) {
        long sum = 0, nn = n;
        do {
            sum += cache[(int)(nn % 10)];
            if (sum > n) {
                return false;
            }
            nn /= 10;
        } while (nn > 0);

        return sum == n;
    }
}
0
1
3435
438579088

JavaScript

ES6

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);
Output:
1
3435


Or, composing reusable primitives:

(() => {
    'use strict';

    const main = () =>
        filter(isMunchausen, enumFromTo(1, 5000));

    // isMunchausen :: Int -> Bool
    const isMunchausen = n =>
        n.toString()
        .split('')
        .reduce(
            (a, c) => (
                d => a + Math.pow(d, d)
            )(parseInt(c, 10)),
            0
        ) === n;

    // GENERIC ---------------------------

    // enumFromTo :: Int -> Int -> [Int]
    const enumFromTo = (m, n) =>
        Array.from({
            length: 1 + n - m
        }, (_, i) => m + i);

    // filter :: (a -> Bool) -> [a] -> [a]
    const filter = (f, xs) => xs.filter(f);


    // MAIN ---
    return main();
})();
Output:
[1, 3435]

jq

Works with: jq version 1.5
def sigma( stream ): reduce stream as $x (0; . + $x ) ;

def ismunchausen:
   def digits: tostring | split("")[] | tonumber;
   . == sigma(digits | pow(.;.));

# Munchausen numbers from 1 to 5000 inclusive:
range(1;5001) | select(ismunchausen)
Output:
1
3435

Julia

Works with: Julia version 1.0
println([n for n = 1:5000 if sum(d^d for d in digits(n)) == n])
Output:
[1, 3435]

Kotlin

As it doesn't take long to find all 4 known Munchausen numbers, we will test numbers up to 500 million here rather than just 5000:

// version 1.0.6

val powers = IntArray(10)

fun isMunchausen(n: Int): Boolean {
    if (n < 0) return false
    var sum = 0L
    var nn = n
    while (nn > 0) {
        sum += powers[nn % 10]
        if (sum > n.toLong()) return false
        nn /= 10
    }
    return sum == n.toLong()  
}

fun main(args: Array<String>) {
   // cache n ^ n for n in 0..9, defining 0 ^ 0 = 0 for this purpose
   for (i in 1..9) powers[i] = Math.pow(i.toDouble(), i.toDouble()).toInt()

   // check numbers 0 to 500 million
   println("The Munchausen numbers between 0 and 500 million are:")
   for (i in 0..500000000) if (isMunchausen(i))print ("$i ")
   println()
}
Output:
The Munchausen numbers between 0 and 500 million are:
0 1 3435 438579088

Lambdatalk

{def munch
 {lambda {:w}
  {= :w {+ {S.map {{lambda {:w :i}
                           {pow {W.get :i :w} {W.get :i :w}}} :w}
                  {S.serie 0 {- {W.length :w} 1}}}}} }}
-> munch

{S.map {lambda {:i} {if {munch :i} then :i else}}
       {S.serie 1 5000}} 
-> 
1
3435

langur

Translation of: C#
# sum power of digits
val .spod = f(.n) fold f{+}, map(f .x^.x, s2n toString .n)

# Munchausen
writeln "Answers: ", filter f(.n) .n == .spod(.n), series 0..5000
Output:
Answers: [1, 3435]

LDPL

data:
d is number
i is number
n is number
sum is number

procedure:
for i from 1 to 5001 step 1 do
    store 0 in sum
    store i in n
    while n is greater than 0 do
        modulo n by 10 in d
        raise d to d in d
        add sum and d in sum
        divide n by 10 in n
        floor n
    repeat
    if sum is equal to i then
        display i lf
    end if
repeat
Output:
1
3435

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

-- alternative, faster version based on the C version, 
-- avoiding string manipulation, for Lua 5.3 or higher
local function isMunchausen (n)
    local sum, digit, acc = 0, 0, n
    while acc > 0 do
        digit = acc % 10.0
        sum = sum + digit ^ digit
        acc = acc // 10 -- integer div
    end
    return sum == n
end

for i = 1, 5000 do
    if isMunchausen(i) then print(i) end
end
Output:
1
3435

M2000 Interpreter

Module Munchausen {
      Inventory p=0:=0,1:=1
      for i=2 to 9 {Append p, i:=i**i}
      Munchausen=lambda p (x)-> {
            m=0
            t=x
            do {
                  m+=p(x mod 10)
                  x=x div 10
            } until x=0
            =m=t
      }
      For i=1 to 5000
            If Munchausen(i) then print i,
      Next i
      Print
}
Munchausen

Using Array instead of Inventory

Module Münchhausen {
      Dim p(0 to 9)
      p(0)=0, 1
      for i=2 to 9 {p(i)=i**i}
      Münchhausen=lambda p() (x)-> {
            m=0
            t=x
            do {
                  m+=p(x mod 10)
                  x=x div 10
            } until x=0
            =m=t
      }
      For i=1 to 5000
            If Münchhausen(i) then print i,
      Next i
      Print
}
Münchhausen
Output:
       1     3435

MAD

            NORMAL MODE IS INTEGER
            DIMENSION P(5)
            
            THROUGH CLCPOW, FOR D=0, 1, D.G.5
            P(D) = D
            THROUGH CLCPOW, FOR X=1, 1, X.GE.D
CLCPOW      P(D) = P(D) * D

            THROUGH TEST, FOR D1=0, 1, D1.G.5
            THROUGH TEST, FOR D2=0, 1, D2.G.5
            THROUGH TEST, FOR D3=0, 1, D3.G.5
            THROUGH TEST, FOR D4=1, 1, D4.G.5
            N = D1*1000 + D2*100 + D3*10 + D4
            WHENEVER P(D1)+P(D2)+P(D3)+P(D4) .E. N
                PRINT FORMAT FMT,N
TEST        END OF CONDITIONAL

            VECTOR VALUES FMT = $I4*$
            END OF PROGRAM
Output:
    1
3435

Maple

isMunchausen := proc(n::posint) 
local num_digits; 
num_digits := map(x -> StringTools:-Ord(x) - 48, StringTools:-Explode(convert(n, string))); 
return evalb(n = convert(map(x -> x^x, num_digits), `+`)); 
end proc;

Munchausen_upto := proc(n::posint) local k, count, list_num; 
list_num := []; 
for k to n do 
    if isMunchausen(k) then 
       list_num := [op(list_num), k]; 
    end if; 
end do; 
return list_num; 
end proc;

Munchausen_upto(5000);
Output:
[1, 3435]

Mathematica/Wolfram Language

Off[Power::indet];(*Supress 0^0 warnings*)
Select[Range[5000], Total[IntegerDigits[#]^IntegerDigits[#]] == # &]
Output:
{1,3435}

min

Works with: min version 0.19.3
(dup string "" split (int dup pow) (+) map-reduce ==) :munchausen?
1 :i
(i 5000 <=) ((i munchausen?) (i puts!) when i succ @i) while
Output:
1
3435

Modula-2

MODULE MunchausenNumbers;
FROM FormatString IMPORT FormatString;
FROM Terminal IMPORT WriteString,ReadChar;

(* Simple power function, does not handle negatives *)
PROCEDURE Pow(b,e : INTEGER) : INTEGER;
VAR result : INTEGER;
BEGIN
    IF e=0 THEN
        RETURN 1;
    END;
    IF b=0 THEN
        RETURN 0;
    END;

    result := b;
    DEC(e);
    WHILE e>0 DO
        result := result * b;
        DEC(e);
    END;
    RETURN result;
END Pow;

VAR
    buf : ARRAY[0..31] OF CHAR;
    i,sum,number,digit : INTEGER;
BEGIN
    FOR i:=1 TO 5000 DO
        (* Loop through each digit in i
           e.g. for 1000 we get 0, 0, 0, 1. *)
        sum := 0;
        number := i;
        WHILE number>0 DO
            digit := number MOD 10;
            sum := sum + Pow(digit, digit);
            number := number DIV 10;
        END;
        IF sum=i THEN
            FormatString("%i\n", buf, i);
            WriteString(buf);
        END;
    END;

    ReadChar;
END MunchausenNumbers.

Nim

import math

for i in 1..<5000:
  var sum: int64 = 0
  var number = i
  while number > 0:
    var digit = number mod 10
    sum += digit ^ digit
    number = number div 10
  if sum == i:
    echo i
Output:
1
3435

OCaml

let is_munchausen n =
  let pwr = [|1; 1; 4; 27; 256; 3125; 46656; 823543; 16777216; 387420489|] in
  let rec aux x = if x < 10 then pwr.(x) else aux (x / 10) + pwr.(x mod 10) in
  n = aux n

let () =
  Seq.(ints 1 |> take 5000 |> filter is_munchausen |> iter (Printf.printf " %u"))
  |> print_newline
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 have to create Combinations_with_repetitions and 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 combination of the digits of number leads to the sum of power of digits. Therefore I need leading zero's.

{$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.
Output:
         1  000000001
      3435  000003345
 438579088  034578889

Check Count 43758 == 
n= maxdigits = 9,k = 10;CombWithRep = (10+9-1))!/(10!*(9-1)!)=43758

real    0m0.002s

Perl

use List::Util "sum";
for my $n (1..5000) {
  print "$n\n" if $n == sum( map { $_**$_ } split(//,$n) );
}
Output:
1
3435

Phix

with javascript_semantics
constant powers = sq_power(tagset(9),tagset(9))
 
function munchausen(integer n)
    integer n0 = n
    atom total = 0
    while n!=0 do
        integer r = remainder(n,10)
        if r then total += powers[r] end if
        n = floor(n/10)
    end while
    return (total==n0)
end function
 
for m in tagset(5000) & 438579088 do
    if munchausen(m) then ?m end if
end for
Output:

Checking every number between 5,000 and 438,579,088 would take/waste a couple of minutes, and it wouldn't prove anything unless it went to 99,999,999,999 which would take a very long time!

1
3435
438579088

Alternative

function munchausen(integer lo, maxlen)
    string digits = sprint(lo)
    sequence res = {}
    integer count = 0, l = length(digits)
    atom lim = power(10,l), lom = 0
    while length(digits)<=maxlen do
        count += 1
        atom tot = 0
        for j=1 to length(digits) do
            integer d = digits[j]-'0'
            if d then tot += power(d,d) end if
        end for
        if tot>=lom and tot<=lim and sort(sprint(tot))=digits then
            res &= tot
        end if
        for j=length(digits) to 0 by -1 do
            if j=0 then
                digits = repeat('0',length(digits)+1)
                lim *= 10
                lom = (lom+1)*10-1
                exit
            elsif digits[j]<'9' then
                digits[j..$] = digits[j]+1
                exit
            end if
        end for
    end while
    return {count,res}
end function
atom t0 = time()
printf(1,"Munchausen 1..4 digits (%d combinations checked): %v\n",munchausen(1,4))
printf(1,"All Munchausen, 0..11 digits (%d combinations): %v\n",munchausen(0,11))
?elapsed(time()-t0)
Output:
Munchausen 1..4 digits (999 combinations checked): {1,3435}
All Munchausen, 0..11 digits (352715 combinations): {0,1,3435,438579088}
"0.3s"

PHP

<?php 

$pwr = array_fill(0, 10, 0);

function isMunchhausen($n)
{
    global $pwr;
    $sm = 0;
    $temp = $n;
    while ($temp) {
        $sm= $sm + $pwr[($temp % 10)];
        $temp = (int)($temp / 10);
    }
    return $sm == $n;
}

for ($i = 0; $i < 10; $i++) {
    $pwr[$i] = pow((float)($i), (float)($i));
}

for ($i = 1; $i < 5000 + 1; $i++) {
    if (isMunchhausen($i)) {
        echo $i . PHP_EOL;
    }
}
Output:
1
3435

Picat

go =>
  println([N : N in 1..5000, munchhausen_number(N)]).

munchhausen_number(N) =>
  N == sum([T : I in N.to_string(),II = I.to_int(), T = II**II]).
Output:
[1,3435]

Testing for a larger interval, 1..500 000 000, requires another approach:

go2 ?=>
  H = [0] ++ [I**I : I in 1..9],
  N = 1,
  while (N < 500_000_000)
    Sum = 0,
    NN = N,
    Found = true,
    while (NN > 0, Found == true)
       Sum := Sum + H[1+(NN mod 10)],
       if Sum > N then
         Found := false
       end,
       NN := NN div 10
    end,
    if Sum == N then
      println(N)
    end,
    N := N+1
  end,
  nl.
Output:
1
3435
438579088

PicoLisp

(for N 5000
   (and
      (=
         N
         (sum
            '((N) (** N N))
            (mapcar format (chop N)) ) )
      (println N) ) )
Output:
1
3435

PL/I

munchausen: procedure options(main);
    /* precalculate powers */
    declare (pows(0:5), i) fixed;
    pows(0) = 0; /* 0^0=0 for Munchausen numbers */
    do i=1 to 5; pows(i) = i**i; end;
    
    declare (d1, d2, d3, d4, num, dpow) fixed;
    do d1=0 to 5;
        do d2=0 to 5;
            do d3=0 to 5;
                do d4=1 to 5;
                    num = d1*1000 + d2*100 + d3*10 + d4;
                    dpow = pows(d1) + pows(d2) + pows(d3) + pows(d4);
                    if num=dpow then put skip list(num);
                end;
            end;
        end;
    end;
end munchausen;
Output:
        1
     3435

Plain English

To run:
Start up.
Show the Munchausen numbers up to 5000.
Wait for the escape key.
Shut down.

To show the Munchausen numbers up to a number:
If a counter is past the number, exit.
If the counter is Munchausen, convert the counter to a string; write the string to the console.
Repeat.

To decide if a number is Munchausen:
Privatize the number.
Find the sum of the digit self powers of the number.
If the number is the original number, say yes.
Say no.

To find the sum of the digit self powers of a number:
If the number is 0, exit.
Put 0 into a sum number.
Loop.
Divide the number by 10 giving a quotient and a remainder.
Put the quotient into the number.
Raise the remainder to the remainder.
Add the remainder to the sum.
If the number is 0, break.
Repeat.
Put the sum into the number.
Output:
1
3435

PowerBASIC

Translation of: FreeBASIC
(Translated from the FreeBasic Version 2 example.)
#COMPILE EXE
#DIM ALL
#COMPILER PBCC 6

DECLARE FUNCTION GetTickCount LIB "kernel32.dll" ALIAS "GetTickCount"() AS DWORD

FUNCTION PBMAIN () AS LONG
LOCAL i, j, n, sum, ten1, ten2, t AS DWORD
LOCAL n0, n1, n2, n3, n4, n5, n6, n7, n8, n9 AS DWORD
LOCAL s1, s2, s3, s4, s5, s6, s7, s8 AS DWORD
DIM pow(9) AS DWORD, num(9) AS DWORD
LOCAL pb AS BYTE PTR
LOCAL number AS STRING

  t = GetTickCount()
  ten2 = 10
  FOR i = 1 TO 9
    pow(i) = i
    FOR j = 2 TO i
      pow(i) *= i
    NEXT j
  NEXT i
  FOR n = 1 TO 11
    FOR n9 = 0 TO n
      FOR n8 = 0 TO n - n9
        s8 = n9 + n8
        FOR n7 = 0 TO n - s8
          s7 = s8 + n7
          FOR n6 = 0 TO n - s7
            s6 = s7 + n6
            FOR n5 = 0 TO n - s6
              s5 = s6 + n5
              FOR n4 = 0 TO n - s5
                s4 = s5 + n4
                FOR n3 = 0 TO n - s4
                  s3 = s4 + n3
                  FOR n2 = 0 TO n - s3
                    s2 = s3 + n2
                    FOR n1 = 0 TO n - s2
                      n0 = n - (s2 + n1)
                      sum = n1 * pow(1) + n2 * pow(2) + n3 * pow(3) + _
                            n4 * pow(4) + n5 * pow(5) + n6 * pow(6) + _
                            n7 * pow(7) + n8 * pow(8) + n9 * pow(9)
                      SELECT CASE AS LONG sum
                      CASE ten1 TO ten2 - 1
                        number = LTRIM$(STR$(sum))
                        pb = STRPTR(number)
                        MAT num() = ZER
                        FOR i = 0 TO n -1
                          j = @pb[i] - 48
                          INCR num(j)
                        NEXT i
                        IF n0 = num(0) AND n1 = num(1) AND n2 = num(2) AND _
                           n3 = num(3) AND n4 = num(4) AND n5 = num(5) AND _
                           n6 = num(6) AND n7 = num(7) AND n8 = num(8) AND _
                           n9 = num(9) THEN CON.PRINT STR$(sum)
                      END SELECT
                    NEXT n1
                  NEXT n2
                NEXT n3
              NEXT n4
            NEXT n5
          NEXT n6
        NEXT n7
      NEXT n8
    NEXT n9
    ten1 = ten2
    ten2 *= 10
  NEXT n
  t = GetTickCount() - t
  CON.PRINT "execution time:" & STR$(t) & " ms; hit any key to end program"
  CON.WAITKEY$
END FUNCTION
Output:
 0
 1
 3435
 438579088
execution time: 78 ms; hit any key to end program

Pure

// split numer into digits
digits n::number = loop n [] with
                     loop n l = loop (n div 10) ((n mod 10):l) if n > 0;
                              = l otherwise; end;

munchausen n::int = (filter isMunchausen list) when
                      list = 1..n; end with
                      isMunchausen n = n == foldl (+) 0
                                       (map (\d -> d^d)
                                        (digits n)); end;
munchausen 5000;
Output:
[1,3435]

PureBasic

Translation of: C
EnableExplicit
Declare main()

If OpenConsole("Munchausen_numbers")
  main() : Input() : End
EndIf

Procedure main()
  Define i.i,
         sum.i,
         number.i,
         digit.i  
  For i = 1 To 5000
    sum = 0
    number = i
    While number > 0
      digit = number % 10
      sum + Pow(digit, digit)
      number / 10
    Wend  
    If sum = i
      PrintN(Str(i))
    EndIf
  Next
EndProcedure
Output:
1
3435

Python

for i in range(5000):
    if i == sum(int(x) ** int(x) for x in str(i)):
        print(i)
Output:
1
3435


Or, defining an isMunchausen predicate in terms of a single fold – rather than a two-pass sum after map (or comprehension) –

and reaching for a specialised digitToInt, which turns out to be a little faster than type coercion with the more general built-in int():

Works with: Python version 3
'''Munchausen numbers'''

from functools import (reduce)


# isMunchausen :: Int -> Bool
def isMunchausen(n):
    '''True if n equals the sum of
       each of its digits raised to
       the power of itself.'''
    def powerOfSelf(d):
        i = digitToInt(d)
        return i**i
    return n == reduce(
        lambda n, c: n + powerOfSelf(c),
        str(n), 0
    )


# main :: IO ()
def main():
    '''Test'''
    print(list(filter(
        isMunchausen,
        enumFromTo(1)(5000)
    )))


# GENERIC -------------------------------------------------

# digitToInt :: Char -> Int
def digitToInt(c):
    '''The integer value of any digit character
       drawn from the 0-9, A-F or a-f ranges.'''
    oc = ord(c)
    if 48 > oc or 102 < oc:
        return None
    else:
        dec = oc - 48   # ord('0')
        hexu = oc - 65  # ord('A')
        hexl = oc - 97  # ord('a')
    return dec if 9 >= dec else (
        10 + hexu if 0 <= hexu <= 5 else (
            10 + hexl if 0 <= hexl <= 5 else None
        )
    )


# enumFromTo :: (Int, Int) -> [Int]
def enumFromTo(m):
    '''Integer enumeration from m to n.'''
    return lambda n: list(range(m, 1 + n))


if __name__ == '__main__':
    main()
[1, 3435]

Quackery

 [ dup 0 swap
   [ dup 0 != while
     10 /mod dup **
     rot + swap again ] 
    drop = ]             is munchausen ( n --> b )

  5000 times
    [ i^ 1+ munchausen if
      [ i^ 1+ echo sp ] ]
Output:
1 3435 

Racket

#lang racket

(define (expt:0^0=1 r p)
  (if (zero? r) 0 (expt r p)))

(define (munchausen-number? n (t n))
  (if (zero? n)
      (zero? t)
      (let-values (([q r] (quotient/remainder n 10)))
        (munchausen-number? q (- t (expt:0^0=1 r r))))))

(module+ main
  (for-each displayln (filter munchausen-number? (range 1 (add1 5000)))))

(module+ test
  (require rackunit)
  ;; this is why we have the (if (zero? r)...) test
  (check-equal? (expt 0 0) 1)
  (check-equal? (expt:0^0=1 0 0) 0)
  (check-equal? (expt:0^0=1 0 4) 0)
  (check-equal? (expt:0^0=1 3 4) (expt 3 4))
  ;; given examples
  (check-true (munchausen-number? 1))
  (check-true (munchausen-number? 3435))
  (check-false (munchausen-number? 3))
  (check-false (munchausen-number? -45) "no recursion on -ve numbers"))
Output:
1
3435

Raku

(formerly Perl 6)

sub is_munchausen ( Int $n ) {
    constant @powers = 0, |map { $_ ** $_ }, 1..9;
    $n == @powers[$n.comb].sum;
}
.say if .&is_munchausen for 1..5000;
Output:
1
3435

REXX

version 1

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
Output:
D:\mau>rexx munch
1
3435

version 2

This REXX version uses the requirement that   0**0   equals zero.

It is about   2.5   times faster than REXX version 1.

For the high limit of   5,000,   optimization isn't needed.   But for much higher limits, optimization becomes significant.

/*REXX program finds and displays Münchhausen numbers from one to a specified number (Z)*/
@.= 0;         do i=1  for 9;  @.i= i**i;  end   /*precompute powers for non-zero digits*/
parse arg z .                                    /*obtain optional argument from the CL.*/
if z=='' | z==","  then z= 5000                  /*Not specified?  Then use the default.*/
@is='is a Münchhausen number.';   do j=1  for z  /* [↓]  traipse through all the numbers*/
                                  if isMunch(j)  then say  right(j, 11)    @is
                                  end   /*j*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isMunch: parse arg x 1 ox;  $= 0;   do  until  x==''  |  $>ox       /*stop if too large.*/
                                    parse var x _ +1 x;  $= $ + @._ /*add the next power*/
                                    end   /*while*/                 /* [↑]  get a digit.*/
         return $==ox                                               /*it is or it ain't.*/
output   when using the default input:
          1 is a Münchhausen number.
       3435 is a Münchhausen number.

version 3

It is about   3   times faster than REXX version 1.

/*REXX program finds and displays Münchhausen numbers from one to a specified number (Z)*/
@.= 0;         do i=1  for 9;  @.i= i**i;  end   /*precompute powers for non-zero digits*/
parse arg z .                                    /*obtain optional argument from the CL.*/
if z=='' | z==","  then z= 5000                  /*Not specified?  Then use the default.*/
@is='is a Münchhausen number.';   do j=1  for z  /* [↓]  traipse through all the numbers*/
                                  if isMunch(j)  then say  right(j, 11)    @is
                                  end   /*j*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
isMunch: parse arg a 2 b 3 c 4 d 5 e 6 x 1 ox; $=@.a+@.b+@.c+@.d+@.e /*sum 1st 5 digits.*/
         if $>ox  then return 0                                      /*is sum too large?*/
                                  do  while  x\==''  &  $<=ox        /*any more digits ?*/
                                  parse var x _ +1 x;   $= $ + @._   /*sum 6th & up digs*/
                                  end   /*while*/
         return $==ox                                                /*it is or it ain't*/
output   is the same as the 2nd REXX version.


Ring

# Project : Munchausen numbers

limit = 5000

for n=1 to limit
    sum = 0
    msum = string(n)
    for m=1 to len(msum)
        ms = number(msum[m])
        sum = sum + pow(ms, ms)
    next
    if sum = n
       see n + nl
    ok
next

Output:

1
3435

RPL

≪ { } 1 5000 FOR j
     j →STR DUP SIZE 0 1 ROT FOR k
        OVER k DUP SUB STR→ DUP ^ +
     NEXT
     SWAP DROP
     IF j == THEN j + END
  NEXT
≫
EVAL 
Output:
1: { 1 3435 }

Ruby

  puts (1..5000).select{|n| n.digits.sum{|d| d**d} == n}
Output:
1
3435

Rust

fn main() {
    let mut solutions = Vec::new();

    for num in 1..5_000 {
        let power_sum = num.to_string()
            .chars()
            .map(|c| {
                let digit = c.to_digit(10).unwrap();
                (digit as f64).powi(digit as i32) as usize
            })
            .sum::<usize>();

        if power_sum == num {
            solutions.push(num);
        }
    }

    println!("Munchausen numbers below 5_000 : {:?}", solutions);
}
Output:
Munchausen numbers below 5_000 : [1, 3435]

Scala

Adapted from Zack Denton's code posted on Munchausen Numbers and How to Find Them.

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)")
    }
  }
}
Output:
1 (munchausen)
3435 (munchausen)

Sidef

func is_munchausen(n) {
    n.digits.map{|d| d**d }.sum == n
}

say (1..5000 -> grep(is_munchausen))
Output:
[1, 3435]

SuperCollider

(1..5000).select { |n| n == n.asDigits.sum { |x| pow(x, x) } }
[1, 3435]

Swift

import Foundation

func isMünchhausen(_ n: Int) -> Bool {
  let nums = String(n).map(String.init).compactMap(Int.init)

  return Int(nums.map({ pow(Double($0), Double($0)) }).reduce(0, +)) == n
}

for i in 1...5000 where isMünchhausen(i) {
  print(i)
}
Output:
1
3435

Symsyn

x : 10 1
 
 (2^2) x.2
 (3^3) x.3
 (4^4) x.4
 (5^5) x.5
 (6^6) x.6
 (7^7) x.7
 (8^8) x.8
 (9^9) x.9

 1 i
 if i <= 5000
    ~ i $i          | convert binary to string
    #$i j           | length to j
    y               | set y to 0 
    if j > 0
       $i.j $j 1    | move digit j to string j
       ~ $j n       | convert j string to binary
       + x.n y      | add value x at n to y
       - j          | dec j 
       goif
    endif
    if i = y
       i []         | output to console
    endif
    + i
    goif
 endif
Output:
1
3435

TI-83 BASIC

Works with: TI-83 BASIC version TI-84Plus 2.55MP
Translation of: Fortran
  For(I,1,5000)
    0→S:I→K
    For(J,1,4)
      10^(4-J)→D
      iPart(K/D)→N
      remainder(K,D)→R
      If N≠0:S+N^N→S
      R→K
    End
    If S=I:Disp I
  End
Output:
           1
        3435

Execution time: 15 min

Optimized Version

Translation of: BASIC

This takes advantage of the fact that N^N > 9999 for any single digit natural number N where N > 6. It also uses a look up table for powers to allow the assumption that 0^0 = 1.

{1,1,4,27,256,3125}→L₁
For(A,0,5,1)
For(B,0,5,1)
For(C,0,5,1)
For(D,0,5,1)
A*1000+B*100+C*10+D→N
L₁(D+1)→M
If N≥10
M+L₁(C+1)→M
If N≥100
M+L₁(B+1)→M
If N≥1000
M+L₁(A+1)→M
If N=M
Disp N
End
End
End
End
Output:
           1
        3435

Execution time: 2 minutes 20 seconds

VBA

Option Explicit

Sub Main_Munchausen_numbers()
Dim i&

    For i = 1 To 5000
        If IsMunchausen(i) Then Debug.Print i & " is a munchausen number."
    Next i
End Sub

Function IsMunchausen(Number As Long) As Boolean
Dim Digits, i As Byte, Tot As Long

    Digits = Split(StrConv(Number, vbUnicode), Chr(0))
    For i = 0 To UBound(Digits) - 1
        Tot = (Digits(i) ^ Digits(i)) + Tot
    Next i
    IsMunchausen = (Tot = Number)
End Function
Output:
1 is a munchausen number.
3435 is a munchausen number.

VBScript

for i = 1 to 5000
    if Munch(i) Then
        Wscript.Echo i, "is a Munchausen number"
    end if
next

'Returns True if num is a Munchausen number. This is true if the sum of
'each digit raised to that digit's power is equal to the given number.
'Example: 3435 = 3^3 + 4^4 + 3^3 + 5^5

Function Munch (num)

    dim str: str = Cstr(num)    'input num as a string
    dim sum: sum = 0            'running sum of n^n
    dim i                       'loop index
    dim n                       'extracted digit

    for i = 1 to len(str)
        n = CInt(Mid(str,i,1))
        sum = sum + n^n
    next

    Munch = (sum = num)

End Function
Output:
1 is a Munchausen number
3435 is a Munchausen number

Visual Basic

Translation of: FreeBASIC
(Translated from the FreeBasic Version 2 example.)
Option Explicit

Declare Function GetTickCount Lib "kernel32.dll" () As Long
Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (ByRef Destination As Any, ByVal Length As Long)


Sub Main()
Dim i As Long, j As Long, n As Long, t As Long
Dim sum As Double
Dim n0 As Double
Dim n1 As Double
Dim n2 As Double
Dim n3 As Double
Dim n4 As Double
Dim n5 As Double
Dim n6 As Double
Dim n7 As Double
Dim n8 As Double
Dim n9 As Double
Dim ten1 As Double
Dim ten2 As Double
Dim s1 As Long
Dim s2 As Long
Dim s3 As Long
Dim s4 As Long
Dim s5 As Long
Dim s6 As Long
Dim s7 As Long
Dim s8 As Long
Dim pow(9) As Long, num(9) As Long
Dim number As String, res As String

  t = GetTickCount()
  ten2 = 10
  For i = 1 To 9
    pow(i) = i
    For j = 2 To i
      pow(i) = i * pow(i)
    Next j
  Next i
  For n = 1 To 11
    For n9 = 0 To n
      For n8 = 0 To n - n9
        s8 = n9 + n8
        For n7 = 0 To n - s8
          s7 = s8 + n7
          For n6 = 0 To n - s7
            s6 = s7 + n6
            For n5 = 0 To n - s6
              s5 = s6 + n5
              For n4 = 0 To n - s5
                s4 = s5 + n4
                For n3 = 0 To n - s4
                  s3 = s4 + n3
                  For n2 = 0 To n - s3
                    s2 = s3 + n2
                    For n1 = 0 To n - s2
                      n0 = n - (s2 + n1)
                      sum = n1 * pow(1) + n2 * pow(2) + n3 * pow(3) + _
                            n4 * pow(4) + n5 * pow(5) + n6 * pow(6) + _
                            n7 * pow(7) + n8 * pow(8) + n9 * pow(9)
                      Select Case sum
                      Case ten1 To ten2 - 1
                        number = CStr(sum)
                        ZeroMemory num(0), 40
                        For i = 1 To n
                          j = Asc(Mid$(number, i, 1)) - 48
                          num(j) = num(j) + 1
                        Next i
                        If n0 = num(0) Then
                          If n1 = num(1) Then
                            If n2 = num(2) Then
                              If n3 = num(3) Then
                                If n4 = num(4) Then
                                  If n5 = num(5) Then
                                    If n6 = num(6) Then
                                      If n7 = num(7) Then
                                        If n8 = num(8) Then
                                          If n9 = num(9) Then
                                            res = res & CStr(sum) & vbNewLine
                                          End If
                                        End If
                                      End If
                                    End If
                                  End If
                                End If
                              End If
                            End If
                          End If
                        End If
                      End Select
                    Next n1
                  Next n2
                Next n3
              Next n4
            Next n5
          Next n6
        Next n7
      Next n8
    Next n9
    ten1 = ten2
    ten2 = ten2 * 10
  Next n
  t = GetTickCount() - t
  res = res & "execution time:" & Str$(t) & " ms"
  MsgBox res
End Sub
Output:
 0
 1
 3435
 438579088
execution time: 156 ms

Visual Basic .NET

Translation of: FreeBASIC
(Translated from the FreeBasic Version 2 example.)

Computation time is under 4 seconds on tio.run.

Imports System

Module Program
    Sub Main()
        Dim i, j, n, n1, n2, n3, n4, n5, n6, n7, n8, n9, s2, s3, s4, s5, s6, s7, s8 As Integer,
            sum, ten1 As Long, ten2 As Long = 10
        Dim pow(9) As Long, num() As Byte
        For i = 1 To 9 : pow(i) = i : For j = 2 To i : pow(i) *= i : Next : Next
        For n = 1 To 11 : For n9 = 0 To n : For n8 = 0 To n - n9 : s8 = n9 + n8 : For n7 = 0 To n - s8
                s7 = s8 + n7 : For n6 = 0 To n - s7 : s6 = s7 + n6 : For n5 = 0 To n - s6
                    s5 = s6 + n5 : For n4 = 0 To n - s5 : s4 = s5 + n4 : For n3 = 0 To n - s4
                        s3 = s4 + n3 : For n2 = 0 To n - s3 : s2 = s3 + n2 : For n1 = 0 To n - s2
                            sum = n1 * pow(1) + n2 * pow(2) + n3 * pow(3) + n4 * pow(4) + 
                                  n5 * pow(5) + n6 * pow(6) + n7 * pow(7) + n8 * pow(8) + n9 * pow(9)
                            If sum < ten1 OrElse sum >= ten2 Then Continue For
                            redim num(9)
                            For Each ch As Char In sum.ToString() : num(Convert.ToByte(ch) - 48) += 1 : Next
                            If n - (s2 + n1) = num(0) AndAlso n1 = num(1) AndAlso n2 = num(2) AndAlso
                                n3 = num(3) AndAlso n4 = num(4) AndAlso n5 = num(5) AndAlso n6 = num(6) AndAlso
                                n7 = num(7) AndAlso n8 = num(8) AndAlso n9 = num(9) Then Console.WriteLine(sum)
                          Next : Next : Next : Next : Next : Next : Next : Next : Next
            ten1 = ten2 : ten2 *= 10
       Next
    End Sub
End Module
Output:
0
1
3435
438579088

Wren

var powers = List.filled(10, 0)
for (i in 1..9) powers[i] = i.pow(i).round // cache powers

var munchausen = Fn.new {|n|
    if (n <= 0) Fiber.abort("Argument must be a positive integer.")
    var nn = n
    var sum = 0
    while (n > 0) {
        var digit = n % 10
        sum = sum + powers[digit]
        n = (n/10).floor
    }
    return nn == sum
}

System.print("The Munchausen numbers <= 5000 are:")
for (i in 1..5000) {
    if (munchausen.call(i)) System.print(i)
}
Output:
The Munchausen numbers <= 5000 are:
1
3435

XPL0

The digits 6, 7, 8 and 9 can't occur because 6^6 = 46656, which is beyond 5000.

int Pow, A, B, C, D, N;
[Pow:= [0, 1, 4, 27, 256, 3125];
for A:= 0 to 5 do
  for B:= 0 to 5 do
    for C:= 0 to 5 do
      for D:= 0 to 5 do
        [N:= A*1000 + B*100 + C*10 + D;
        if Pow(A) + Pow(B) + Pow(C) + Pow(D) = N then
          if N>=1 & N<= 5000 then
                [IntOut(0, N);  CrLf(0)];
        ];
]
Output:
1
3435

zkl

[1..5000].filter(fcn(n){ n==n.split().reduce(fcn(s,n){ s + n.pow(n) },0) })
.println();
Output:
L(1,3435)