Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {
- Computation of Armstrong numbers using (Free) Pascal.
- Henning Polzer, November 14th, 2016
- }
- PROGRAM armstrongzahlen;
- TYPE Tgz = cardinal; { Standard: integer }
- VAR i, og, ug: Tgz;
- FUNCTION armstrong (zahl: Tgz): boolean;
- VAR diverg, n, ziffer, s, summe, z: Tgz;
- FUNCTION potenz (basis, exp: Tgz): Tgz; { Potenz berechnen }
- VAR h, i: Tgz;
- BEGIN { potenz }
- h := basis;
- FOR i := 1 TO exp-1 DO
- h := h*basis;
- potenz := h
- END; { potenz }
- FUNCTION stellen (wert: Tgz): Tgz; { Stellenzahl von "wert" ermitteln }
- BEGIN { stellen }
- IF z <> 0 THEN stellen := trunc ((abs(ln(wert)/ln(10))))+1 ELSE stellen := 1
- END; { stellen }
- BEGIN { armstrong }
- armstrong := false;
- summe := 0;
- z := zahl;
- n := z;
- s := stellen (n); { Anzahl der Stellen der Ausgangszahl }
- REPEAT
- diverg := trunc (z/10);
- ziffer := z-diverg*10;
- z := diverg;
- summe := summe+potenz(ziffer,s)
- UNTIL z < 1;
- IF summe = n THEN armstrong := true
- END; { armstrong }
- BEGIN { Hauptprogramm }
- write ('Untergrenze: '); readln (ug);
- write ('Obergrenze : '); readln (og);
- IF ug < 10 THEN
- BEGIN
- writeln ('Einstellige Zahlen sind trivial und werden übersprungen.');
- ug := 10
- END; { if }
- FOR i := ug TO og DO
- IF armstrong (i) = true THEN writeln (i, ' ')
- END.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement