home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 01 / praxis / ulan.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1989-10-30  |  2.4 KB  |  93 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     ULAN.PAS                           *)
  3. (*        (c) 1989  H.Hagemeyer  &  TOOLBOX               *)
  4. (* ------------------------------------------------------ *)
  5. PROGRAM Terminate;
  6. USES Crt;
  7.  
  8. PROCEDURE Pause;
  9. BEGIN
  10.   WriteLn('- Taste pressen -');
  11.   REPEAT UNTIL Ord (ReadKey) > 0;
  12. END;
  13.  
  14. PROCEDURE Fehler;
  15. BEGIN
  16.   WriteLn; WriteLn;
  17.   WriteLn('Rechenbereich überschritten. ',
  18.           'Programm wird abgebrochen');
  19.   Halt;
  20. END;
  21.  
  22. FUNCTION Ulanfolge(a : LongInt; Anzeige : BOOLEAN): LongInt;
  23. CONST
  24.   TestZahl = 2;
  25. VAR
  26.   z : LongInt;
  27.  
  28.   PROCEDURE Fehler;
  29.   BEGIN
  30.     WriteLn; WriteLn;
  31.     WriteLn('Rechenbereich überschritten. ',
  32.             'Programm wird abgebrochen');
  33.     Halt;
  34.   END;
  35.  
  36. BEGIN
  37.   z := 1;
  38.   IF Anzeige THEN BEGIN
  39.     WriteLn ('Ulanfolge für a = ', a:8);
  40.     WriteLn ('============================');
  41.     WriteLn;
  42.   END;
  43.   WHILE a <> 1 DO BEGIN
  44.     IF (a MOD TestZahl = 0) THEN
  45.       a := a DIV TestZahl
  46.     ELSE
  47.       { Hier ist ein Terminieren dann nicht gewährleistet, }
  48.       { wenn durch Rechenüberschreitungen a < 0 wird.      }
  49.       { Turbo Pascal überprüft leider nicht, ob das Ergeb- }
  50.       { nis einer Multiplikation > MaxLongInt wird. Daher  }
  51.       { muß der Programmierer selbst für eine geeignete Ab-}
  52.       { frage sorgen! Die Abfrage wird benötigt für        }
  53.       { a > 106239 !                                       }
  54.  
  55.       IF a <= (MaxLongInt) DIV 3 THEN
  56.         a := 3 * a + 1
  57.       ELSE
  58.         Fehler;     { mit Abbruch des Programms durch Halt }
  59.       Inc (z, 1);
  60.       IF Anzeige THEN Write (a:10);
  61.     END;
  62.     UlanFolge := z;
  63.   END;
  64.  
  65. CONST
  66.   Nmax     = 1000;
  67.   Nlang    = 26623;
  68. VAR
  69.   i, z, max : LongInt;
  70.  
  71. BEGIN
  72.   ClrScr;
  73.   WriteLn('Berechnung der Ulan-Folge für n = ',
  74.           Nlang, ' (sehr lange Folge)');
  75.   WriteLn;
  76.   Pause;
  77.   i := UlanFolge (Nlang,TRUE) ;         { Sehr lange Folge }
  78.   WriteLn;  WriteLn;
  79.   WriteLn ('Und nun wird die Anzahl der Folge-Glieder bis ',
  80.             Nmax,' ausgegeben :');
  81.   WriteLn;
  82.   Pause;
  83.   max := 1;
  84.   FOR i := 2 TO Nmax DO BEGIN         { Terminiert immer ! }
  85.     z := UlanFolge (i, FALSE);
  86.     IF z > Max THEN BEGIN
  87.       WriteLn(i:5, z:10);
  88.       Max := z;
  89.     END;
  90.   END;
  91. END.
  92. (* ------------------------------------------------------ *)
  93. (*                  Ende von ULAN.PAS                     *)