Munchausen numbers
A Munchausen number is a natural number n the sum of whose digits (in base 10), each raised to the power of itself, equals n.
For instance: 3435 = 33 + 44 + 33 + 55
- Task
Find all Munchausen numbers between 1 and 5000
ALGOL 68
<lang algol68># Find Munchausen Numbers between 1 and 5000 #
- note that 6^6 is 46 656 so we only need to cosider 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 </lang>
- 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. <lang algol68># 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</lang>
- Output:
+0 +1 +3435 +438579088
ALGOL W
<lang algolw>% 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.</lang>
- Output:
1 3435
AppleScript
<lang AppleScript>
on run
filter(isMunchausen, range(1, 5000)) --> {1, 3435}
end run
-- isMunchausen :: Int -> Bool on isMunchausen(n)
(class of n is integer) and ¬ foldl(my digitPowerSum, 0, characters of (n as string)) = n
end isMunchausen
-- digitPowerSum :: Int -> Character -> Int on digitPowerSum(a, c)
set d to c as integer a + (d ^ d)
end digitPowerSum
-- GENERIC LIBRARY FUNCTIONS
-- filter :: (a -> Bool) -> [a] -> [a] on filter(f, xs)
set mf to mReturn(f) set lst to {} set lng to length of xs repeat with i from 1 to lng set v to item i of xs if mf's lambda(v, i, xs) then set end of lst to v end if end repeat return lst
end filter
-- foldl :: (a -> b -> a) -> a -> [b] -> a on foldl(f, startValue, xs)
set mf to mReturn(f) set v to startValue set lng to length of xs repeat with i from 1 to lng set v to mf's lambda(v, item i of xs, i, xs) end repeat return v
end foldl
-- range :: Int -> Int -> [Int]
on range(m, n)
if n < m then set d to -1 else set d to 1 end if set lst to {} repeat with i from m to n by d set end of lst to i end repeat return lst
end range
-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
if class of f is script then return f script property lambda : f end script
end mReturn </lang>
- Output:
<lang AppleScript>{1, 3435}</lang>
C
Adapted from Zack Denton's code posted on Munchausen Numbers and How to Find Them. <lang C>#include <stdio.h>
- include <math.h>
int main() {
for (int i = 1; i < 5000; i++) { // loop through each digit in i // e.g. for 1000 we get 0, 0, 0, 1. int sum = 0; for (int number = i; number > 0; number /= 10) { int digit = number % 10; // find the sum of the digits // raised to themselves sum += pow(digit, digit); } if (sum == i) { // the sum is equal to the number // itself; thus it is a // munchausen number printf("%i\n", i); } } return 0;
}</lang>
- Output:
1 3435
Clojure
<lang lisp>(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))
</lang>
- Output:
(1 3435)
C#
<lang csharp>Func<char, int> toInt = c => c-'0';
foreach (var i in Enumerable.Range(1,5000) .Where(n => n == n.ToString() .Sum(x => Math.Pow(toInt(x), toInt(x))))) Console.WriteLine(i);</lang>
- Output:
1 3435
Elixir
<lang 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)</lang>
- Output:
1 3435
F#
<lang fsharp>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)</lang>
- Output:
[1; 3435]
Haskell
<lang haskell>import Data.List (unfoldr)
isMunchausen :: Integer -> Bool isMunchausen n = (n ==) $ sum $ map (\x -> x^x) $ unfoldr digit n where
digit 0 = Nothing digit n = Just (r,q) where (q,r) = n `divMod` 10
main :: IO () main = print $ filter isMunchausen [1..5000]</lang>
- Output:
[1,3435]
J
Here, it would be useful to have a function which sums the powers of the digits of a number. Once we have that we can use it with an equality test to filter those integers:
<lang J> munch=: +/@(^~@(10&#.inv))
(#~ ] = munch"0) 1+i.5000
1 3435</lang>
Note that wikipedia claims that 0=0^0 in the context of Munchausen numbers. It's not clear why this should be (1 is the multiplicative identity and if you do not multiply it by zero it should still be 1), but it's easy enough to implement. Note also that this does not change the result for this task:
<lang J> munch=: +/@((**^~)@(10&#.inv))
(#~ ] = munch"0) 1+i.5000
1 3435</lang>
Java
Adapted from Zack Denton's code posted on Munchausen Numbers and How to Find Them. <lang Java> public class Main {
public static void main(String[] args) { for(int i = 0 ; i <= 5000 ; i++ ){ int val = String.valueOf(i).chars().map(x -> (int) Math.pow( x-48 ,x-48)).sum(); if( i == val){ System.out.println( i + " (munchausen)"); } } }
}
</lang>
- Output:
1 (munchausen) 3435 (munchausen)
JavaScript
ES6
<lang javascript>for (let i of [...Array(5000).keys()] .filter(n => n == n.toString().split() .reduce((a, b) => a+Math.pow(parseInt(b),parseInt(b)), 0))) console.log(i);</lang>
- Output:
1 3435
Or, composing reusable primitives:
<lang JavaScript>(function () {
'use strict';
// isMunchausen :: Int -> Bool let isMunchausen = n => !isNaN(n) && ( n.toString() .split() .reduce((a, c) => { let d = parseInt(c, 10); return a + Math.pow(d, d); }, 0) === n ),
// range(intFrom, intTo, intStep?) // Int -> Int -> Maybe Int -> [Int] range = (m, n, step) => { let d = (step || 1) * (n >= m ? 1 : -1);
return Array.from({ length: Math.floor((n - m) / d) + 1 }, (_, i) => m + (i * d)); };
return range(1, 5000) .filter(isMunchausen);
})();</lang>
- Output:
<lang JavaScript>[1, 3435]</lang>
Lua
<lang Lua>function isMunchausen (n)
local sum, nStr, digit = 0, tostring(n) for pos = 1, #nStr do digit = tonumber(nStr:sub(pos, pos)) sum = sum + digit ^ digit end return sum == n
end
for i = 1, 5000 do
if isMunchausen(i) then print(i) end
end</lang>
- Output:
1 3435
Pascal
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. <lang pascal>{$IFDEF FPC}{$MODE objFPC}{$ELSE}{$APPTYPE CONSOLE}{$ENDIF} uses
sysutils;
type
tdigit = byte;
const
base = 10; maxDigits = base-1;// set for 32-compilation otherwise overflow.
var
DgtPotDgt : array[0..base-1] of NativeUint; cnt: NativeUint;
function CheckSameDigits(n1,n2:NativeUInt):boolean; var
dgtCnt : array[0..Base-1] of NativeInt; i : NativeUInt;
Begin
fillchar(dgtCnt,SizeOf(dgtCnt),#0); repeat //increment digit of n1 i := n1;n1 := n1 div base;i := i-n1*base;inc(dgtCnt[i]); //decrement digit of n2 i := n2;n2 := n2 div base;i := i-n2*base;dec(dgtCnt[i]); until (n1=0) AND (n2= 0 ); result := true; For i := 0 to Base-1 do result := result AND (dgtCnt[i]=0);
end;
procedure Munch(number,DgtPowSum,minDigit:NativeUInt;digits:NativeInt); var
i: NativeUint;
begin
inc(cnt); number := number*base; IF digits > 1 then Begin For i := minDigit to base-1 do Munch(number+i,DgtPowSum+DgtPotDgt[i],i,digits-1); end else For i := minDigit to base-1 do //number is always the arrangement of the digits leading to smallest number IF (number+i)<= (DgtPowSum+DgtPotDgt[i]) then IF CheckSameDigits(number+i,DgtPowSum+DgtPotDgt[i]) then iF number+i>0 then writeln(Format('%*d %.*d', [maxDigits,DgtPowSum+DgtPotDgt[i],maxDigits,number+i]));
end;
procedure InitDgtPotDgt; var
i,k,dgtpow: NativeUint;
Begin
// digit ^ digit ,special case 0^0 here 0 DgtPotDgt[0]:= 0; For i := 1 to Base-1 do Begin dgtpow := i; For k := 2 to i do dgtpow := dgtpow*i; DgtPotDgt[i] := dgtpow; end;
end;
begin
cnt := 0; InitDgtPotDgt; Munch(0,0,0,maxDigits); writeln('Check Count ',cnt);
end. </lang>
- Output:
1 000000001 3435 000003345 438579088 034578889 Check Count 43758 == n= maxdigits = 9,k = 10;CombWithRep = (10+9-1))!/(10!*(9-1)!)=43758 real 0m0.002s
Perl 6
<lang perl6>sub is_munchausen ( Int $n ) {
constant @powers = 0, |map { $_ ** $_ }, 1..9; $n == @powers[$n.comb].sum;
} .say if .&is_munchausen for 1..5000;</lang>
- Output:
1 3435
REXX
<lang rexx>Do n=0 To 10000
If n=m(n) Then Say n End
Exit m: Parse Arg z res=0 Do While z>
Parse Var z c +1 z res=res+c**c End
Return res</lang>
- Output:
D:\mau>rexx munch 1 3435
Ruby
<lang ruby>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</lang>
- Output:
1 3435
Scala
Adapted from Zack Denton's code posted on Munchausen Numbers and How to Find Them. <lang Scala> object Munch {
def main(args: Array[String]): Unit = { import scala.math.pow (1 to 5000).foreach { i => if (i == (i.toString.toCharArray.map(d => pow(d.asDigit,d.asDigit))).sum) println( i + " (munchausen)") } }
} </lang>
- Output:
1 (munchausen) 3435 (munchausen)
Sidef
<lang ruby>func is_munchausen(n) {
n.digits.map{|d| d**d }.sum == n
}
say (1..5000 -> grep(is_munchausen))</lang>
- Output:
[1, 3435]
zkl
<lang zkl>[1..5000].filter(fcn(n){ n==n.split().reduce(fcn(s,n){ s + n.pow(n) },0) }) .println();</lang>
- Output:
L(1,3435)