Program Wundersame_Zahl;

Uses
 crt;

Var
 Zahl,x:integer;
 c:char;

Begin
 clrscr;
 Writeln ('Berechnung wundersamer Zahlen');
 write ('Zahl eingeben ');
 readln (Zahl);
 x:=Zahl;
 While Zahl<>1 do begin
  If odd(zahl)=true then Zahl:=(Zahl*3+1) else Zahl:=(Zahl div 2);
  Writeln (Zahl);
 end;
 writeln (x,' ist eine wundersame Zahl');
 read (c);
end.

Program Wundersame_Zahl;

const
 max=350;

Uses
 crt;

Var
 i:integer;
 h:array [0..max] of integer;
 c:char;

Procedure Formatieren;
begin
 i:=-1;
 While i<max do begin
  i:=i+1;
  h[i]:=0;
 end
end;

Function Wunderzahl (zahl:longint):integer;
begin
 i:=0;
 While Zahl<>1 do begin
  If odd(zahl)=true then Zahl:=(Zahl*3+1) else Zahl:=(Zahl div 2);
  If i=(max-1) then Zahl:=1;
  i:=i+1
 end;
 Wunderzahl:=i
end;

procedure Histogramm;
var
 Zahl:longint;
Begin
 Zahl:=0;
 While Zahl<50000 do begin
  i:=0;
  Zahl:=Zahl+1;
  h[Wunderzahl(Zahl)]:=h[Wunderzahl(Zahl)]+1
 end
end;

Procedure Speichern;
var
 y:text;
begin
 Writeln ('Speichere');
 Assign (y,'A:\Histogr.txt');
 rewrite (y);
 Writeln (y,'Histogramm von wundersamen Zahlen im Bereich von 1 bis 50000');
 i:=0;
  while i<>max do begin
  writeln (y,i,',',h[i]);
  i:=i+1
 end;
 close (y);
end;

Begin
 clrscr;
 Formatieren;
 Writeln ('Suche wundersamer Zahlen im bereich 1 bis 50000');
 Writeln ('Bitte Warten');
 Histogramm;
 speichern;
 Write ('Weiter mit CR');
 read (c)
end.