Kaprekar's process

{
    Kaprekar's process. To compile run gpc -o kp kp.pas or fpc kp.pas.
    Henning Polzer, May 1st, 2016. Send comments and error reports to:
    h underscore polzer at gmx dot de.
}

PROGRAM Kaprekarprozess;
CONST obergrenze = 8;                   { Max. Anzahl der Stellen des Startwertes
                                      in Abhaengigkeit von Tganzzahl, s. u. }
      max_schritte = 30;                { Zahl der max. ausgefuehrten Rechenschritte }
      periodenlaenge = max_schritte;        { Hoechste erkannte Periodenlaenge }
TYPE Tganzzahl = longint;
VAR zahl: Tganzzahl;
    fehlercode: word;           { Zur Umwandlung des Kommandozeilenparameters }


FUNCTION stellen (z: Tganzzahl): Tganzzahl;     { Ermittelt Stellen der Zahl }
BEGIN
  IF z <> 0 THEN stellen := trunc(abs(ln(z)/ln(10)))+1 ELSE stellen := 1
END; { stellen }


PROCEDURE kaprekar (zahl: Tganzzahl);
VAR a: ARRAY[1..obergrenze] OF Tganzzahl;   { Ziffern der zu untersuchenden Zahl }
    p: ARRAY[1..periodenlaenge] OF Tganzzahl; { Speichert Werte fuer Periodensuche }
    altes_ergebnis, diff, hilf, i, j, min, max, n, schritt, st, startwert: Tganzzahl;
    ende, geordnet, gleich: boolean;

BEGIN
  altes_ergebnis := 0;
  startwert := zahl;
  ende := false;
  schritt := 1;     { Zahl der ausgefuehrten Rechenschritte }
  p[1] := zahl;     { Startwert fuer Periodensuche speichern }
  j := 2;           { Naechsten Wert fuer Periodensuche ab 2. Element eintragen }

  REPEAT
    st := stellen (zahl);

    FOR i := st DOWNTO 1 DO     { Zahl in Ziffern zerlegen und von }
    BEGIN                   { rechts nach links in Feld eintragen }
      a[i] := zahl MOD 10;
      zahl := zahl DIV 10
    END; { for }

    REPEAT                  { Sortieren }
      geordnet := true;
      FOR i := 1 TO st - 1 DO
        IF a[i] > a[i+1] THEN
        BEGIN
          geordnet := false;        { Falsche Anordnung gefunden }
          hilf := a[i];         { Austausch vornehmen }
          a[i] := a[i+1];
          a[i+1] := hilf
        END { if }
    UNTIL geordnet = true;      { Ende, wenn keine falsche Anordnung mehr gefunden }

    gleich := true;             { Ende, wenn alle Stellen des mindestens }
    FOR i := 1 TO st - 1 DO     { zweistelligen >Start<wertes gleich sind, }
      IF a[i] <> a[i+1] THEN gleich := false;   { in spaeteren Schritten koennen Zahlen }
    IF (gleich = true) AND          { auftreten, in denen alle Ziffern gleich }
       (schritt < 2) AND            { sind, vgl. Schritte 1 und 2 bei einem }
       (stellen (startwert) > 1) THEN exit; { Startwert von 101. }

    min := 0;                   { Extrema finden und in den Variablen }
    max := 0;                   { min und max speichern }
    FOR i := 1 TO st DO
    BEGIN
      min := (min + a[i]) * 10;     { Von links nach rechts in Zahl ueberfuehren }
      max := (max + a[st-i+1]) * 10 { Hier von rechts nach links vorgehen }
    END;
    min := min DIV 10;
    IF max DIV 10 <> min THEN max := max DIV 10;

    diff := max - min;          { Ergebnis ausgeben }
    IF (diff = altes_ergebnis) OR (schritt > max_schritte) THEN ende := true
      ELSE writeln (schritt:2, '. Schritt: ', max:8, ' - ', min:8, ' = ', diff:8);
    zahl := diff;

    p[j] := zahl;               { Nach Periode suchen: Ende, wenn gefunden }
    hilf := 0;
    i := 1;
    n := 0;                 { Haelt ggf. Anfang der Periode fest }
    REPEAT
      IF zahl = p[i] THEN
      BEGIN
        hilf := hilf + 1;
        IF n = 0 THEN n := i-1  { n nur aendern, wenn noch Ursprungswert (0, s. o.) }
      END; { if }           { vorhanden, sonst ist bereits Periode erkannt }
      i := i + 1
    UNTIL i = periodenlaenge;
    IF hilf > 1 THEN ende := true;
    IF j = periodenlaenge THEN j := 1 ELSE j := j + 1;

    altes_ergebnis := zahl;
    schritt := schritt + 1
  UNTIL (ende = true);
  writeln ('Periode beginnt bei Schritt ', n, '.')
END; { kaprekar }


BEGIN { Hauptprogramm }
  val (paramstr (1), zahl, fehlercode);
  IF (fehlercode = 0) AND
     (stellen (zahl) > 1) AND       { Zahl soll mindestens zwei Stellen haben }
     (stellen (zahl) <= obergrenze) THEN kaprekar (zahl)
END.