Einführung in die imperative Programmierung

WS 2018/19

Aufgabe 1

program testeZeigListMax(input, output);
   { testet die Funktion ZeigListMax }

 type
   tRefListe = ^tListe;
   tListe = record
   info : integer;
   next : tRefListe
   end;

 var
   Liste,
   MaxZeig : tRefListe;

 function ZeigListMax (inRefAnfang : tRefListe) : tRefListe;
   { bestimmt rekursiv einen Zeiger auf das Listenelement mit
   der groessten Zahl }
   var 
   zeiger: tRefListe;
   begin 
   if  inRefAnfang=nil then
   ZeigListMax:= nil
   else
   begin
   zeiger := ZeigListMax(inRefAnfang^.next);
   if zeiger=nil then
   ZeigListMax := inRefAnfang
   else
   if inRefAnfang^.info > zeiger^.info then
   ZeigListMax := inRefAnfang
   else
   ZeigListMax := zeiger;
   
   end; 
   
   end; 
   
   function ZeigListMaxIt (inRefAnfang : tRefListe) : tRefListe;
   { bestimmt rekursiv einen Zeiger auf das Listenelement mit
   der groessten Zahl }
   var zeiger, zeigerMax: tRefListe;
   begin
   zeiger:= inRefAnfang;
   zeigerMax:= inRefAnfang;
   while zeiger<>nil do
   begin
   if zeiger^.info> zeigerMax^.info then
   zeigerMax:= zeiger; 
   zeiger:= zeiger^.next;
   end;
   
   ZeigListMaxIt := zeigerMax;
   end;
   
   procedure LiesListe(var outListe : tRefListe);
   { Liest eine (evtl. leere) Liste ein und gibt deren
   Anfangszeiger outListe zurueck. }

 var
   Anzahl : integer;
   i : integer;
   neueZahl : integer;
   Listenanfang,
   Listenende : tRefListe;
 

 begin
   Listenanfang := nil;
   repeat
   write ('Wie viele Zahlen wollen Sie eingeben? ');
   readln (Anzahl);
   until Anzahl >= 0;
   
   write ('Bitte geben Sie ', Anzahl, ' Zahlen ein: ');

 { Liste aufbauen }
   for i := 1 to Anzahl do
   begin
   read (neueZahl);
   if Listenanfang = nil then
   begin
   new (Listenanfang);
   Listenanfang^.next := nil;
   Listenanfang^.info := neueZahl;
   Listenende := Listenanfang;
   end
   else
   begin
   new (Listenende^.next);
   Listenende := Listenende^.next;
   Listenende^.next := nil;
   Listenende^.info := neueZahl
   end  { if Liste = nil }
   end; { for }
   outListe := Listenanfang;
   writeln
   end; { LiesListe }
 

begin 
   LiesListe (Liste);
   { Die zu testende Funktion wird zweimal aufgerufen, damit tatsaechlich
   ein Fehler auftritt, wenn die Liste durch den Aufruf zerstoert wird. }
   MaxZeig := ZeigListMax (Liste);
   MaxZeig := ZeigListMaxIt (Liste);
   if MaxZeig = nil then
   writeln('Leere Eingabefolge!')
   else
   writeln ('Das Maximum ist ', MaxZeig^.info, '.')
   end. { testeZeigListMax }
 

Aufgabe 3

program testeBerechneTiefeUndMaxTiefe (input, output);
   { testet die Prozedur BerechneTiefeUndMaxTiefe }

 type
   tRefBinbaum = ^tBinbaum;
   tBinBaum = record
   Info,
   Tiefe : integer;
   links,
   rechts : tRefBinBaum;
   end;
   tNatZahl = 0..maxint;

 var
   Wurzel : tRefBinBaum;
   Max : tNatZahl;

procedure BerechneTiefeUndMaxTiefe (
   inRefWurzel : tRefBinBaum;
   inTiefe : tNatZahl;
   var ioMaxTiefe : tNatZahl);
   { berechnet die Tiefe aller Knoten in einem Binaerbaum, auf
   dessen Wurzel ??RefWurzel zeigt; ??MaxTiefe muss vor dem Aufruf
   mit Null initialisiert sein und liefert die maximale Tiefe }
   
   begin
   if inRefWurzel<>nil then
   begin
   BerechneTiefeUndMaxTiefe(inRefWurzel^.links, inTiefe+1, ioMaxTiefe);
   
   inRefWurzel^.Tiefe := inTiefe;
   if inTiefe> ioMaxTiefe then
   ioMaxTiefe:= inTiefe;
   
   BerechneTiefeUndMaxTiefe(inRefWurzel^.rechts, inTiefe+1, ioMaxTiefe);
   
   end;

end; 
   
   procedure BBKnotenEinfuegen (
   inZahl : integer;
   var ioWurzel : tRefBinBaum);
   { fuegt in den Suchbaum, auf dessen Wurzel ioWurzel
   zeigt, ein Blatt mit Wert inZahl an. }

 var
   Zeiger : tRefBinBaum;

 begin
   if ioWurzel = nil then

 begin
   new (Zeiger);
   Zeiger^.Info := inZahl;
   Zeiger^.links := nil;
   Zeiger^.rechts := nil;
   Zeiger^.Tiefe := 0;
   ioWurzel := Zeiger
   end { if }
   else { ioWurzel <> nil }
   if inZahl < ioWurzel^.info then
   BBKnotenEinfuegen (inZahl, ioWurzel^.links)
   else
   BBKnotenEinfuegen (inZahl, ioWurzel^.rechts);
   end; { BBKnotenEinfuegen }

 procedure BBAufbauen (var outWurzel : tRefBinBaum);
   { Liest eine Folge von Integer-Zahlen ein (0 beendet die
   Eingabe, gehoert aber nicht zur Folge) und speichert
   die Folge in einem binren Suchbaum. }

 var 
   Zahl : integer;

 begin
   outWurzel := nil; { mit leerem Baum initialisieren }
   read (Zahl);
   while Zahl <> 0 do
   begin
   BBKnotenEinfuegen (Zahl, outWurzel);
   read (Zahl)
   end
   end; { BBAufbauen }

 procedure BaumAusgeben(inWurzel : tRefBinBaum);
   { Durchlaeuft den Binaerbaum mit Wurzel inWurzel und gibt
   die Knoteninhalte und Knotentiefen in preorder-Reihenfolge aus. }

 var
   Knoten : tRefBinBaum;

 begin
   if inWurzel <> nil then
   begin
   write (inWurzel^.info, ':', inWurzel^.Tiefe,' ');
   BaumAusgeben (inWurzel^.links);
   BaumAusgeben (inWurzel^.rechts);
   write('u ');
   end; { if }
   end; { BaumAusgeben }
 

begin
   writeln('Bitte integer-Zahlen eingeben (0=Ende):');
   BBAufbauen (Wurzel);
   Max := 0;
   BerechneTiefeUndMaxTiefe (Wurzel, 1, Max);
   WriteLn('Jetzt wird der Baum in preorder-Reihenfolge durchlaufen und die');
   WriteLn('Knoteninhalte in der Form Knoten:Tiefe ausgegeben.');
   WriteLn('Um die Knotentiefen kontrollieren zu koennen, wird bei jedem ');
   WriteLn('Ruecksprung aus der Prozedur ein "u" ausgegeben.');
   BaumAusgeben (Wurzel);
   writeln ('Maximale Tiefe: ', Max);
   end. { testeBerechneTiefeUndMaxTiefe }
 

Anzahl Knoten, Summe usw.

program testeBerechneTiefeUndMaxTiefe (input, output);
 { testet die Prozedur BerechneTiefeUndMaxTiefe }

 type
   tRefBinbaum = ^tBinbaum;
   tBinBaum = record
   Info,
   Tiefe : integer;
   links,
   rechts : tRefBinBaum;
   end;
   tNatZahl = 0..maxint;

 var
   Wurzel : tRefBinBaum;
   Max : tNatZahl;

procedure BerechneTiefeUndMaxTiefe (
   inRefWurzel : tRefBinBaum;
   inTiefe : tNatZahl;
   var ioMaxTiefe : tNatZahl);
   { berechnet die Tiefe aller Knoten in einem Binaerbaum, auf
   dessen Wurzel ??RefWurzel zeigt; ??MaxTiefe muss vor dem Aufruf
   mit Null initialisiert sein und liefert die maximale Tiefe }
   
   begin
   if inRefWurzel<>nil then
   begin
   BerechneTiefeUndMaxTiefe(inRefWurzel^.links, inTiefe+1, ioMaxTiefe);
   
   inRefWurzel^.Tiefe := inTiefe;
   if inTiefe> ioMaxTiefe then
   ioMaxTiefe:= inTiefe;
   
   BerechneTiefeUndMaxTiefe(inRefWurzel^.rechts, inTiefe+1, ioMaxTiefe);
   
   end;

end; 
   
   function AnzahlKnoten(inRefWurzel : tRefBinBaum): integer;
   
   begin
   if inRefWurzel=nil then
   AnzahlKnoten:= 0
   else
   begin
   AnzahlKnoten:= 
   AnzahlKnoten(inRefWurzel^.links) + AnzahlKnoten(inRefWurzel^.rechts)+1; 
   end;
   
   end;
   
   function AnzahlBlaetter(inRefWurzel : tRefBinBaum): integer;
   
   begin
   if inRefWurzel=nil then
   AnzahlBlaetter:=0
   else
   begin
   if (inRefWurzel^.links=nil) and (inRefWurzel^.rechts=nil) then
   AnzahlBlaetter:= 1
   else
   begin
   AnzahlBlaetter:= 
   AnzahlBlaetter(inRefWurzel^.links) + AnzahlBlaetter(inRefWurzel^.rechts); 
   end;
   end;
   
   end; 
   
   function Summe(inRefWurzel : tRefBinBaum): integer;
   
   begin
   if inRefWurzel=nil then
   Summe:= 0
   else
   begin
   Summe:= 
   Summe(inRefWurzel^.links) + Summe(inRefWurzel^.rechts)+inRefWurzel^.Info; 
   end;
   
   end; 
   
   function Produkt(inRefWurzel : tRefBinBaum): integer;
   
   begin
   if inRefWurzel=nil then
   Produkt:= 1
   else
   begin
   Produkt:= 
   Produkt(inRefWurzel^.links) * Produkt(inRefWurzel^.rechts)*inRefWurzel^.Info; 
   end;
   
   end; 
   
   procedure BBKnotenEinfuegen (
   inZahl : integer;
   var ioWurzel : tRefBinBaum);
   { fuegt in den Suchbaum, auf dessen Wurzel ioWurzel
   zeigt, ein Blatt mit Wert inZahl an. }

 var
   Zeiger : tRefBinBaum;

 begin
   if ioWurzel = nil then

 begin
   new (Zeiger);
   Zeiger^.Info := inZahl;
   Zeiger^.links := nil;
   Zeiger^.rechts := nil;
   Zeiger^.Tiefe := 0;
   ioWurzel := Zeiger
   end { if }
   else { ioWurzel <> nil }
   if inZahl < ioWurzel^.info then
   BBKnotenEinfuegen (inZahl, ioWurzel^.links)
   else
   BBKnotenEinfuegen (inZahl, ioWurzel^.rechts);
   end; { BBKnotenEinfuegen }

 procedure BBAufbauen (var outWurzel : tRefBinBaum);
   { Liest eine Folge von Integer-Zahlen ein (0 beendet die
   Eingabe, gehoert aber nicht zur Folge) und speichert
   die Folge in einem binren Suchbaum. }

 var 
   Zahl : integer;

 begin
   outWurzel := nil; { mit leerem Baum initialisieren }
   read (Zahl);
   while Zahl <> 0 do
   begin
   BBKnotenEinfuegen (Zahl, outWurzel);
   read (Zahl)
   end
   end; { BBAufbauen }

 procedure BaumAusgeben(inWurzel : tRefBinBaum);
   { Durchlaeuft den Binaerbaum mit Wurzel inWurzel und gibt
   die Knoteninhalte und Knotentiefen in preorder-Reihenfolge aus. }

 var
   Knoten : tRefBinBaum;

 begin
   if inWurzel <> nil then
   begin
   write (inWurzel^.info, ':', inWurzel^.Tiefe,' ');
   BaumAusgeben (inWurzel^.links);
   BaumAusgeben (inWurzel^.rechts);
   write('u ');
   end; { if }
   end; { BaumAusgeben }
 

begin
   writeln('Bitte integer-Zahlen eingeben (0=Ende):');
   BBAufbauen (Wurzel);
   
   writeln ('Anzahl Knoten: ', AnzahlKnoten(Wurzel));
   
   writeln ('Anzahl Blätter: ', AnzahlBlaetter(Wurzel));
   
   writeln ('Summe Knoten.Info: ', Summe(Wurzel));
   
   writeln ('Produkt Knoten.Info: ', Produkt(Wurzel));
   
   end. { testeBerechneTiefeUndMaxTiefe }
 

Pascalsches Dreieck

program liste (input,output);
 type
 tRefListe = ^tListe;
 tListe = record
 zahl : integer;
 next : tRefListe;
 end;
 
 var 
 listenanfang : tRefListe; 
 zeiger : tRefListe; 
 endeListe , neuzeile: tRefListe;
 
 eingabe : integer;
 
 function Dreieck(inListe:tRefListe):tRefListe;
 { Erzeugt aus einer Reihe des Pascalschen Dreiecks
 die nächste Reihe. }
 
 var neuliste,zeiger,neu: tRefListe;
 
 begin
 zeiger:=inListe;
 new(neuliste);
 neuliste^.zahl := 1;
 neuliste^.next := nil;
 
 while zeiger<>nil do
 begin
 new(neu);
 if zeiger^.next<>nil then
 begin
 neu^.zahl := zeiger^.zahl + zeiger^.next^.zahl;
 neu^.next := neuliste;
 neuliste:= neu;
 end
 else 
 begin
 neu^.zahl := 1;
 neu^.next := neuliste;
 neuliste:= neu;
 end; 
 zeiger:= zeiger^.next;
 end;
 
 Dreieck:= neuliste;
 
 end;
 

 
   procedure alleDrucken(zuDrucken:  tRefListe);
   var
   zeiger: tRefListe;
   begin
   zeiger := zuDrucken;
   while zeiger <> nil do 
   begin
   writeln(zeiger^.zahl);
   zeiger:= zeiger^.next;
   end;
   end;
   BEGIN
   listenanfang := nil;
   writeln('Eingabe der Zahlen, Beenden mit 0'); 
   readln(eingabe);
   while eingabe <> 0 do
   begin
   new(zeiger);
   zeiger^.zahl := eingabe;
   zeiger^.next:=nil;
   if listenanfang = nil then
   listenanfang := zeiger
   else
   endeListe^.next:=zeiger;
   endeListe := zeiger; 
   readln(eingabe);
   end;
   
   alleDrucken(listenanfang);
   
   neuZeile := Dreieck(listenanfang);
   
   alleDrucken(neuZeile);
   
   END.

Fibonacci

program Fibonacci;

var i:integer;

function fibo(inZahl: integer): integer;
   begin
   if inZahl=0 then
   fibo := 0
   else 
   if inZahl=1 then
   fibo:=1
   else
   fibo := fibo(inZahl-1) + fibo(inZahl-2);

end;

BEGIN
   readln(i);
   writeln( fibo(i));
   
   END.