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



ALGOL 68[edit]

# 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[edit]

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

AppleScript[edit]

-- 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 ¬
foldl(digitPowerSum, 0, characters of (n as string)) = n
 
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 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 enumFromTo
 
-- filter :: (a -> Bool) -> [a] -> [a]
on filter(f, xs)
tell 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 |λ|(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}

AWK[edit]

 
# 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[edit]

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[edit]

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[edit]

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

C[edit]

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#[edit]

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[edit]

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

C++[edit]

 
#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[edit]

(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)

D[edit]

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

Elixir[edit]

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

FreeBASIC[edit]

Version 1[edit]

' 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[edit]

' 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

F#[edit]

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]

Go[edit]

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[edit]

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]
Output:
[1,3435]

The Haskell libraries provide a lot of flexibility – we could also rework the sum, map, and unfold above to a single fold:

import Data.Char (digitToInt)
 
isMunchausen :: Int -> Bool
isMunchausen n =
n ==
foldr
(\c n ->
let v = digitToInt c
in n + v ^ v)
0
(show n)
 
main :: IO ()
main = print $ filter isMunchausen [1 .. 5000]
Output:
[1,3435]

J[edit]

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=: +/@(^[email protected](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[edit]

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[edit]

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[edit]

ES6[edit]

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:

(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);
 
})();


Output:
[1, 3435]

Julia[edit]

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

Kotlin[edit]

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

Lua[edit]

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

Mathematica[edit]

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

Pascal[edit]

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[edit]

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

Perl 6[edit]

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

Phix[edit]

sequence powers = 0&sq_power(tagset(9),tagset(9))
 
function munchausen(integer n)
integer n0 = n
atom summ = 0
while n!=0 do
summ += powers[remainder(n,10)+1]
n = floor(n/10)
end while
return summ=n0
end function
 
for i=1 to 5000 do
if munchausen(i) then ?i end if
end for
Output:
1
3435

PicoLisp[edit]

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


Pure[edit]

// 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]

Python[edit]

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

Racket[edit]

#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

REXX[edit]

version 1[edit]

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[edit]

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

It is about 2.5 times faster than 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

          1 is a Münchhausen number.
       3435 is a Münchhausen number.

version 3[edit]

It is about 3 times faster than 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; [email protected].[email protected].[email protected].[email protected].[email protected].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[edit]

 
# Project : Munchausen numbers
# Date  : 2017/09/30
# Author  : Gal Zsolt (~ CalmoSoft ~)
# Email  : <[email protected]>
 
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

Ruby[edit]

POW = [0] + (1..9).map{|i| i**i}
 
def munchausen_number?(n)
digits(n).inject(0){|sum,i| sum + POW[i]} == n
end
 
def digits(n)
ary = []
while n > 0
n,mod = n.divmod(10)
ary << mod
end
ary
end
 
(1..5000).each do |i|
puts i if munchausen_number?(i)
end
Output:
1
3435

Rust[edit]

 
use std::f64;
 
fn main () {
let mut solutions = Vec::new();
for i in 1..5_000 {
if i.to_string()
.chars()
.map(|c| (c.to_digit(10).unwrap() as f64).powi(c.to_digit(10).unwrap() as i32) as i32)
.fold(0, |n, i| n + i) == i { solutions.push(i); }
}
println!("Munchausen numbers below 5_000 : {:?}", solutions);
}
 
Output:
Munchausen numbers below 5_000 : [1, 3435]

Scala[edit]

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[edit]

func is_munchausen(n) {
n.digits.map{|d| d**d }.sum == n
}
 
say (1..5000 -> grep(is_munchausen))
Output:
[1, 3435]

VBA[edit]

 
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[edit]

 
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

zkl[edit]

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