Advertisement
hpolzer

Armstrong numbers

Nov 15th, 2016
141
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 1.33 KB | None | 0 0
  1. {
  2.     Computation of Armstrong numbers using (Free) Pascal.
  3.     Henning Polzer, November 14th, 2016
  4. }
  5.  
  6. PROGRAM armstrongzahlen;
  7. TYPE Tgz = cardinal; { Standard: integer }
  8. VAR i, og, ug: Tgz;
  9.  
  10. FUNCTION armstrong (zahl: Tgz): boolean;
  11. VAR diverg, n, ziffer, s, summe, z: Tgz;
  12.  
  13.   FUNCTION potenz (basis, exp: Tgz): Tgz; { Potenz berechnen }
  14.   VAR h, i: Tgz;
  15.  
  16.   BEGIN { potenz }
  17.     h := basis;
  18.     FOR i := 1 TO exp-1 DO
  19.       h := h*basis;
  20.     potenz := h
  21.   END; { potenz }
  22.  
  23.   FUNCTION stellen (wert: Tgz): Tgz; { Stellenzahl von "wert" ermitteln }
  24.   BEGIN { stellen }
  25.     IF z <> 0 THEN stellen := trunc ((abs(ln(wert)/ln(10))))+1 ELSE stellen := 1
  26.   END; { stellen }
  27.  
  28. BEGIN { armstrong }
  29.   armstrong := false;
  30.   summe := 0;
  31.   z := zahl;
  32.   n := z;
  33.   s := stellen (n); { Anzahl der Stellen der Ausgangszahl }
  34.  
  35.   REPEAT
  36.     diverg := trunc (z/10);
  37.     ziffer := z-diverg*10;
  38.     z := diverg;
  39.     summe := summe+potenz(ziffer,s)
  40.   UNTIL z < 1;
  41.   IF summe = n THEN armstrong := true
  42. END; { armstrong }
  43.  
  44.  
  45. BEGIN { Hauptprogramm }
  46.   write ('Untergrenze: '); readln (ug);
  47.   write ('Obergrenze : '); readln (og);
  48.  
  49.   IF ug < 10 THEN
  50.   BEGIN
  51.     writeln ('Einstellige Zahlen sind trivial und werden übersprungen.');
  52.     ug := 10
  53.   END; { if }
  54.  
  55.   FOR i := ug TO og DO
  56.     IF armstrong (i) = true THEN writeln (i, ' ')
  57. END.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement