Data commit

Task/Disarium-numbers/Action-/disarium-numbers.action

@@ -0,0 +1,52 @@
+;;; find some Disarium Numbers - numbers whose digit-position power sume
+;;;      are equal to the number,  e.g.: 135 = 1^1 + 3^2 + 5^3
+
+PROC Main()
+
+  DEFINE MAX_DISARIUM = "9999"
+
+  CARD ARRAY power( 40 )  ; table of powers up to the fourth power ( 1:4, 0:9 )
+  CARD n, d, powerOfTen, count, length, v, p, dps, nsub, nprev
+
+  ; compute the n-th powers of 0-9
+  FOR d = 0 TO 9 DO power( d ) = D OD
+  nsub  = 10
+  nprev =  0
+  FOR n = 2 TO 4 DO
+    power( nsub ) = 0
+    FOR d = 1 TO 9 DO
+      power( nsub + d ) = power( nprev + d ) * d
+    OD
+    nprev = nsub
+    nsub ==+ 10
+  OD
+
+  ; print the Disarium numbers up to 9999 or the 18th, whichever is sooner
+  powerOfTen = 10
+  length     =  1
+  count = 0 n = 0
+  WHILE n < MAX_DISARIUM AND count < 18 DO
+    IF n = powerOfTen THEN
+      ; the number of digits just increased
+      powerOfTen ==* 10
+      length     ==+  1
+    FI
+    ; form the digit power sum
+    v   = n
+    p   = length * 10;
+    dps = 0;
+    FOR d = 1 TO length DO
+      p   ==- 10
+      dps ==+ power( p + ( v MOD 10 ) )
+      v   ==/ 10
+    OD
+    IF dps = N THEN
+      ; n is Disarium
+      count ==+ 1;
+      Put( '  )
+      PrintC( n )
+    FI
+    n ==+ 1
+  OD
+
+RETURN