aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Task/Munchausen-numbers/00-META.yaml Normal file
View file

@ -0,0 +1,2 @@
---
from: http://rosettacode.org/wiki/Munchausen_numbers

16
Task/Munchausen-numbers/00-TASK.txt Normal file
View file

@ -0,0 +1,16 @@
A [[wp:Munchausen number|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: &nbsp; <big> 3435 = 3<sup>3</sup> + 4<sup>4</sup> + 3<sup>3</sup> + 5<sup>5</sup> </big>
;Task
Find all Munchausen numbers between &nbsp; '''1''' &nbsp; and &nbsp; '''5000'''.
;Also see:
:* The OEIS entry: [[oeis:A046253| A046253]]
:* The Wikipedia entry: [[wp:Perfect_digit-to-digit_invariant| Perfect digit-to-digit invariant, redirected from ''Munchausen Number'']]
<br><br>

3
Task/Munchausen-numbers/11l/munchausen-numbers.11l Normal file
View file

@ -0,0 +1,3 @@
L(i) 5000
I i == sum(String(i).map(x -> Int(x) ^ Int(x)))
print(i)

32
Task/Munchausen-numbers/360-Assembly/munchausen-numbers.360 Normal file
View file

@ -0,0 +1,32 @@
* 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

107
Task/Munchausen-numbers/8080-Assembly/munchausen-numbers.8080 Normal file
View file

@ -0,0 +1,107 @@
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

38
Task/Munchausen-numbers/ALGOL-68/munchausen-numbers-1.alg Normal file
View file

@ -0,0 +1,38 @@
# 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

59
Task/Munchausen-numbers/ALGOL-68/munchausen-numbers-2.alg Normal file
View file

@ -0,0 +1,59 @@
# 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

43
Task/Munchausen-numbers/ALGOL-W/munchausen-numbers.alg Normal file
View file

@ -0,0 +1,43 @@
% 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.

1
Task/Munchausen-numbers/APL/munchausen-numbers.apl Normal file
View file

@ -0,0 +1 @@
(⊢(/⍨)⊢=+/∘(*⍨∘⍎¨⍕)¨)⍳ 5000

14
Task/Munchausen-numbers/AWK/munchausen-numbers.awk Normal file
View file

@ -0,0 +1,14 @@
# 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)
}

49
Task/Munchausen-numbers/Action-/munchausen-numbers.action Normal file
View file

@ -0,0 +1,49 @@
;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

25
Task/Munchausen-numbers/Ada/munchausen-numbers.ada Normal file
View file

@ -0,0 +1,25 @@
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;

80
Task/Munchausen-numbers/AppleScript/munchausen-numbers-1.applescript Normal file
View file

@ -0,0 +1,80 @@
------------------- 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

1
Task/Munchausen-numbers/AppleScript/munchausen-numbers-2.applescript Normal file
View file

@ -0,0 +1 @@
{1, 3435}

14
Task/Munchausen-numbers/AppleScript/munchausen-numbers-3.applescript Normal file
View file

@ -0,0 +1,14 @@
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

1
Task/Munchausen-numbers/AppleScript/munchausen-numbers-4.applescript Normal file
View file

@ -0,0 +1 @@
{1, 3435}

11
Task/Munchausen-numbers/Arturo/munchausen-numbers.arturo Normal file
View file

@ -0,0 +1,11 @@
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
]

9
Task/Munchausen-numbers/AutoHotkey/munchausen-numbers.ahk Normal file
View file

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

12
Task/Munchausen-numbers/BASIC/munchausen-numbers.basic Normal file
View file

@ -0,0 +1,12 @@
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

19
Task/Munchausen-numbers/BBC-BASIC/munchausen-numbers.basic Normal file
View file

@ -0,0 +1,19 @@
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%

3
Task/Munchausen-numbers/BQN/munchausen-numbers.bqn Normal file
View file

@ -0,0 +1,3 @@
Dgts ← •Fmt-'0'˙
IsMnch ← ⊢=+´∘(⋆˜ Dgts)
IsMnch¨⊸/ 1+↕5000

22
Task/Munchausen-numbers/C++/munchausen-numbers.cpp Normal file
View file

@ -0,0 +1,22 @@
#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;
}

6
Task/Munchausen-numbers/C-sharp/munchausen-numbers-1.cs Normal file
View file

@ -0,0 +1,6 @@
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);

43
Task/Munchausen-numbers/C-sharp/munchausen-numbers-2.cs Normal file
View file

@ -0,0 +1,43 @@
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;
}
}
}

26
Task/Munchausen-numbers/C-sharp/munchausen-numbers-3.cs Normal file
View file

@ -0,0 +1,26 @@
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;
}
}
}

23
Task/Munchausen-numbers/C/munchausen-numbers.c Normal file
View file

@ -0,0 +1,23 @@
#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;
}

22
Task/Munchausen-numbers/CLU/munchausen-numbers.clu Normal file
View file

@ -0,0 +1,22 @@
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

33
Task/Munchausen-numbers/COBOL/munchausen-numbers.cobol Normal file
View file

@ -0,0 +1,33 @@
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)

23
Task/Munchausen-numbers/Clojure/munchausen-numbers.clj Normal file
View file

@ -0,0 +1,23 @@
(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))

34
Task/Munchausen-numbers/Common-Lisp/munchausen-numbers.lisp Normal file
View file

@ -0,0 +1,34 @@
;;; 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)))))

22
Task/Munchausen-numbers/Cowgol/munchausen-numbers.cowgol Normal file
View file

@ -0,0 +1,22 @@
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;

30
Task/Munchausen-numbers/Craft-Basic/munchausen-numbers.basic Normal file
View file

@ -0,0 +1,30 @@
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

21
Task/Munchausen-numbers/D/munchausen-numbers.d Normal file
View file

@ -0,0 +1,21 @@
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);
}
}
}

4
Task/Munchausen-numbers/Dc/munchausen-numbers.dc Normal file
View file

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

11
Task/Munchausen-numbers/Elixir/munchausen-numbers.elixir Normal file
View file

@ -0,0 +1,11 @@
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)

5
Task/Munchausen-numbers/F-Sharp/munchausen-numbers.fs Normal file
View file

@ -0,0 +1,5 @@
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)

11
Task/Munchausen-numbers/FALSE/munchausen-numbers.false Normal file
View file

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

10
Task/Munchausen-numbers/FOCAL/munchausen-numbers.focal Normal file
View file

@ -0,0 +1,10 @@
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

7
Task/Munchausen-numbers/Factor/munchausen-numbers.factor Normal file
View file

@ -0,0 +1,7 @@
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 .

61
Task/Munchausen-numbers/Forth/munchausen-numbers.fth Normal file
View file

@ -0,0 +1,61 @@
: 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 ;

12
Task/Munchausen-numbers/Fortran/munchausen-numbers-1.f Normal file
View file

@ -0,0 +1,12 @@
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

14
Task/Munchausen-numbers/Fortran/munchausen-numbers-2.f Normal file
View file

@ -0,0 +1,14 @@
! 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

32
Task/Munchausen-numbers/FreeBASIC/munchausen-numbers-1.basic Normal file
View file

@ -0,0 +1,32 @@
' 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

65
Task/Munchausen-numbers/FreeBASIC/munchausen-numbers-2.basic Normal file
View file

@ -0,0 +1,65 @@
' 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

8
Task/Munchausen-numbers/Frink/munchausen-numbers.frink Normal file
View file

@ -0,0 +1,8 @@
isMunchausen = { |x|
sum = 0
for d = integerDigits[x]
sum = sum + d^d
return sum == x
}
println[select[1 to 5000, isMunchausen]]

36
Task/Munchausen-numbers/Go/munchausen-numbers.go Normal file
View file

@ -0,0 +1,36 @@
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()
}

13
Task/Munchausen-numbers/Haskell/munchausen-numbers-1.hs Normal file
View file

@ -0,0 +1,13 @@
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]

9
Task/Munchausen-numbers/Haskell/munchausen-numbers-2.hs Normal file
View file

@ -0,0 +1,9 @@
import Data.Char (digitToInt)
isMunchausen :: Int -> Bool
isMunchausen =
(==)
<*> foldr ((+) . (id >>=) (^) . digitToInt) 0 . show
main :: IO ()
main = print $ filter isMunchausen [1 .. 5000]

21
Task/Munchausen-numbers/Haskell/munchausen-numbers-3.hs Normal file
View file

@ -0,0 +1,21 @@
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]

3
Task/Munchausen-numbers/J/munchausen-numbers-1.j Normal file
View file

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

3
Task/Munchausen-numbers/J/munchausen-numbers-2.j Normal file
View file

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

10
Task/Munchausen-numbers/Java/munchausen-numbers-1.java Normal file
View file

@ -0,0 +1,10 @@
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)");
}
}
}
}

29
Task/Munchausen-numbers/Java/munchausen-numbers-2.java Normal file
View file

@ -0,0 +1,29 @@
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;
}
}

4
Task/Munchausen-numbers/JavaScript/munchausen-numbers-1.js Normal file
View file

@ -0,0 +1,4 @@
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);

32
Task/Munchausen-numbers/JavaScript/munchausen-numbers-2.js Normal file
View file

@ -0,0 +1,32 @@
(() => {
'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();
})();

1
Task/Munchausen-numbers/JavaScript/munchausen-numbers-3.js Normal file
View file

@ -0,0 +1 @@
[1, 3435]

8
Task/Munchausen-numbers/Jq/munchausen-numbers-1.jq Normal file
View file

@ -0,0 +1,8 @@
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)

2
Task/Munchausen-numbers/Jq/munchausen-numbers-2.jq Normal file
View file

@ -0,0 +1,2 @@
1
3435

1
Task/Munchausen-numbers/Julia/munchausen-numbers.julia Normal file
View file

@ -0,0 +1 @@
println([n for n = 1:5000 if sum(d^d for d in digits(n)) == n])

25
Task/Munchausen-numbers/Kotlin/munchausen-numbers.kotlin Normal file
View file

@ -0,0 +1,25 @@
// 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()
}

12
Task/Munchausen-numbers/Lambdatalk/munchausen-numbers.lambdatalk Normal file
View file

@ -0,0 +1,12 @@
{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

5
Task/Munchausen-numbers/Langur/munchausen-numbers-1.langur Normal file
View file

@ -0,0 +1,5 @@
# sum power of digits
val .spod = f(.n) fold f{+}, map(f (.x-'0') ^ (.x-'0'), s2cp toString .n)
# Munchausen
writeln "Answers: ", filter f(.n) .n == .spod(.n), series 0..5000

5
Task/Munchausen-numbers/Langur/munchausen-numbers-2.langur Normal file
View file

@ -0,0 +1,5 @@
# 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

24
Task/Munchausen-numbers/Lua/munchausen-numbers.lua Normal file
View file

@ -0,0 +1,24 @@
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

18
Task/Munchausen-numbers/M2000-Interpreter/munchausen-numbers-1.m2000 Normal file
View file

@ -0,0 +1,18 @@
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

19
Task/Munchausen-numbers/M2000-Interpreter/munchausen-numbers-2.m2000 Normal file
View file

@ -0,0 +1,19 @@
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

19
Task/Munchausen-numbers/MAD/munchausen-numbers.mad Normal file
View file

@ -0,0 +1,19 @@
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

17
Task/Munchausen-numbers/Maple/munchausen-numbers.maple Normal file
View file

@ -0,0 +1,17 @@
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);

2
Task/Munchausen-numbers/Mathematica/munchausen-numbers.math Normal file
View file

@ -0,0 +1,2 @@
Off[Power::indet];(*Supress 0^0 warnings*)
Select[Range[5000], Total[IntegerDigits[#]^IntegerDigits[#]] == # &]

3
Task/Munchausen-numbers/Min/munchausen-numbers.min Normal file
View file

@ -0,0 +1,3 @@
(dup string "" split (int dup pow) (+) map-reduce ==) :munchausen?
1 :i
(i 5000 <=) ((i munchausen?) (i puts!) when i succ @i) while

46
Task/Munchausen-numbers/Modula-2/munchausen-numbers.mod2 Normal file
View file

@ -0,0 +1,46 @@
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.

11
Task/Munchausen-numbers/Nim/munchausen-numbers.nim Normal file
View file

@ -0,0 +1,11 @@
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

8
Task/Munchausen-numbers/OCaml/munchausen-numbers.ocaml Normal file
View file

@ -0,0 +1,8 @@
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

25
Task/Munchausen-numbers/PHP/munchausen-numbers.php Normal file
View file

@ -0,0 +1,25 @@
<?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;
}
}

19
Task/Munchausen-numbers/PL-I/munchausen-numbers.pli Normal file
View file

@ -0,0 +1,19 @@
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;

72
Task/Munchausen-numbers/Pascal/munchausen-numbers.pas Normal file
View file

@ -0,0 +1,72 @@
{$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.

4
Task/Munchausen-numbers/Perl/munchausen-numbers.pl Normal file
View file

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

18
Task/Munchausen-numbers/Phix/munchausen-numbers.phix Normal file
View file

@ -0,0 +1,18 @@
(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">powers</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sq_power</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">9</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">),</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">9</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">))</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">munchausen</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">n0</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">n</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">total</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">0</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">total</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">powers</span><span style="color: #0000FF;">[</span><span style="color: #7060A8;">remainder</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">,</span><span style="color: #000000;">10</span><span style="color: #0000FF;">)+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
<span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">floor</span><span style="color: #0000FF;">(</span><span style="color: #000000;">n</span><span style="color: #0000FF;">/</span><span style="color: #000000;">10</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">return</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">total</span><span style="color: #0000FF;">==</span><span style="color: #000000;">n0</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">5000</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">munchausen</span><span style="color: #0000FF;">(</span><span style="color: #000000;">i</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span> <span style="color: #0000FF;">?</span><span style="color: #000000;">i</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<!--

5
Task/Munchausen-numbers/Picat/munchausen-numbers-1.picat Normal file
View file

@ -0,0 +1,5 @@
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]).

20
Task/Munchausen-numbers/Picat/munchausen-numbers-2.picat Normal file
View file

@ -0,0 +1,20 @@
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.

8
Task/Munchausen-numbers/PicoLisp/munchausen-numbers.l Normal file
View file

@ -0,0 +1,8 @@
(for N 5000
(and
(=
N
(sum
'((N) (** N N))
(mapcar format (chop N)) ) )
(println N) ) )

28
Task/Munchausen-numbers/Plain-English/munchausen-numbers.plain Normal file
View file

@ -0,0 +1,28 @@
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.

73
Task/Munchausen-numbers/PowerBASIC/munchausen-numbers.basic Normal file
View file

@ -0,0 +1,73 @@
#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

11
Task/Munchausen-numbers/Pure/munchausen-numbers.pure Normal file
View file

@ -0,0 +1,11 @@
// 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;

25
Task/Munchausen-numbers/PureBasic/munchausen-numbers.basic Normal file
View file

@ -0,0 +1,25 @@
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

3
Task/Munchausen-numbers/Python/munchausen-numbers-1.py Normal file
View file

@ -0,0 +1,3 @@
for i in range(5000):
if i == sum(int(x) ** int(x) for x in str(i)):
print(i)

56
Task/Munchausen-numbers/Python/munchausen-numbers-2.py Normal file
View file

@ -0,0 +1,56 @@
'''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()

9
Task/Munchausen-numbers/Quackery/munchausen-numbers.quackery Normal file
View file

@ -0,0 +1,9 @@
[ 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 ] ]

12
Task/Munchausen-numbers/REXX/munchausen-numbers-1.rexx Normal file
View file

@ -0,0 +1,12 @@
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

13
Task/Munchausen-numbers/REXX/munchausen-numbers-2.rexx Normal file
View file

@ -0,0 +1,13 @@
/*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.*/

15
Task/Munchausen-numbers/REXX/munchausen-numbers-3.rexx Normal file
View file

@ -0,0 +1,15 @@
/*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*/

26
Task/Munchausen-numbers/Racket/munchausen-numbers.rkt Normal file
View file

@ -0,0 +1,26 @@
#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"))

5
Task/Munchausen-numbers/Raku/munchausen-numbers.raku Normal file
View file

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

15
Task/Munchausen-numbers/Ring/munchausen-numbers.ring Normal file
View file

@ -0,0 +1,15 @@
# 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

1
Task/Munchausen-numbers/Ruby/munchausen-numbers.rb Normal file
View file

@ -0,0 +1 @@
puts (1..5000).select{|n| n.digits.sum{|d| d**d} == n}

19
Task/Munchausen-numbers/Rust/munchausen-numbers.rust Normal file
View file

@ -0,0 +1,19 @@
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);
}

9
Task/Munchausen-numbers/Scala/munchausen-numbers.scala Normal file
View file

@ -0,0 +1,9 @@
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)")
}
}
}

5
Task/Munchausen-numbers/Sidef/munchausen-numbers.sidef Normal file
View file

@ -0,0 +1,5 @@
func is_munchausen(n) {
n.digits.map{|d| d**d }.sum == n
}
say (1..5000 -> grep(is_munchausen))

13
Task/Munchausen-numbers/Sinclair-ZX81-BASIC/munchausen-numbers.basic Normal file
View file

@ -0,0 +1,13 @@
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

1
Task/Munchausen-numbers/SuperCollider/munchausen-numbers.sc Normal file
View file

@ -0,0 +1 @@
(1..5000).select { |n| n == n.asDigits.sum { |x| pow(x, x) } }

Some files were not shown because too many files have changed in this diff Show more