51 lines
980 B
Text
51 lines
980 B
Text
MODULE DisariumNumbers;
|
|
FROM InOut IMPORT WriteLn, WriteCard;
|
|
|
|
CONST Max = 2500;
|
|
VAR n: CARDINAL;
|
|
|
|
PROCEDURE cpow(base, power: CARDINAL): CARDINAL;
|
|
VAR i, result: CARDINAL;
|
|
BEGIN
|
|
result := 1;
|
|
FOR i := 1 TO power DO
|
|
result := result * base
|
|
END;
|
|
RETURN result
|
|
END cpow;
|
|
|
|
PROCEDURE length(n: CARDINAL): CARDINAL;
|
|
VAR len: CARDINAL;
|
|
BEGIN
|
|
len := 1;
|
|
WHILE n > 10 DO
|
|
INC(len);
|
|
n := n DIV 10
|
|
END;
|
|
RETURN len
|
|
END length;
|
|
|
|
PROCEDURE digitpowersum(n: CARDINAL): CARDINAL;
|
|
VAR powsum, exp: CARDINAL;
|
|
BEGIN
|
|
powsum := 0;
|
|
FOR exp := length(n) TO 1 BY -1 DO
|
|
powsum := powsum + cpow(n MOD 10, exp);
|
|
n := n DIV 10
|
|
END;
|
|
RETURN powsum
|
|
END digitpowersum;
|
|
|
|
PROCEDURE disarium(n: CARDINAL): BOOLEAN;
|
|
BEGIN
|
|
RETURN digitpowersum(n) = n
|
|
END disarium;
|
|
|
|
BEGIN
|
|
FOR n := 0 TO Max DO
|
|
IF disarium(n) THEN
|
|
WriteCard(n, 5);
|
|
WriteLn
|
|
END
|
|
END
|
|
END DisariumNumbers.
|