Data commit

Task/Disarium-numbers/Modula-2/disarium-numbers.mod2

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