Einführung in die imperative Programmierung

WS 2016/17

 

Fakultät

{$B+} {$R+}
program fakultaet;
 type 
   tIntErlaubt= 0..15;
 var i : tIntErlaubt;
 function fak(n: tIntErlaubt): integer;
   begin
   if n=0 then
   fak:=1
   else
   fak:= n* fak(n-1);
   end;
BEGIN
   readln(i);
   if i>15 then
   writeln('Fehler')
   else 
   writeln(fak(i));
   
   END.

Fibonacci

{$B+} {$R+}
program fibonacci;
 type 
   tNatZahl= 0..maxint;
 var i : real;
 function fibo(n: real): real;
   begin
   if n=0 then
   fibo:=0;
   if n=1 then
   fibo:=1;
   if n>1 then
   fibo:= fibo(n-1) + fibo(n-2);
   end;
BEGIN
   readln(i);
   
   writeln(fibo(i));
   
   END.

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 maxZeiger: tRefListe;
   
   begin
   if inRefAnfang=nil then
   ZeigListMax:= inRefAnfang
   else
   begin
   maxZeiger:= ZeigListMax(inRefAnfang^.next);
   if maxZeiger=nil then
   ZeigListMax:= inRefAnfang
   else 
   if inRefAnfang^.info < maxZeiger^.info then
   ZeigListMax:= maxZeiger
   else
   ZeigListMax:= inRefAnfang;
   end;
 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 := ZeigListMax (Liste);
   if MaxZeig = nil then
   writeln('Leere Eingabefolge!')
   else
   writeln ('Das Maximum ist ', MaxZeig^.info, '.')
   end. { testeZeigListMax }
 

Aufgabe 2

program TesteBlattMax (input, output);
 type
   tNatZahl = 1..maxint;
   tRefBinBaum = ^tBinBaum;
   tBinBaum = record
   Wert:tNatZahl;
   links:tRefBinBaum;
   rechts:tRefBinBaum
   end;
   
   var
   Wurzel : tRefBinBaum;
   blaetterSindMax : Boolean;
   
   function BlattMax ( inRefWurzel : tRefBinBaum; pfadMax : tNatZahl) : Boolean;
   { prüft ob alle Blätter des Baumes die Maxima der Pfade zu ihnen sind }
   var 
   BlattMaxLinks:boolean; 
   BlattMaxRechts:boolean;
   currentMax:tNatZahl;
   begin
   currentMax:=pfadMax;
   if (inRefWurzel^.links=nil) and (inRefWurzel^.rechts=nil) then
   {Blatt gefunden}
   begin
   if inRefWurzel^.Wert <= currentMax then
   BlattMax:= false
   else 
   BlattMax:=true
   end
   else 
   begin
   if  inRefWurzel^.Wert > pfadMax then
   currentMax:= inRefWurzel^.Wert;
   BlattMaxLinks:=true;
   BlattMaxRechts:=true;
   if inRefWurzel^.links <> nil then
   BlattMaxLinks:= BlattMax(inRefWurzel^.links,currentMax);
   if inRefWurzel^.rechts <> nil then
   BlattMaxRechts:= BlattMax(inRefWurzel^.rechts,currentMax); 
   
   BlattMax:= BlattMaxLinks and BlattMaxRechts;
   end;
   
   end;
   
   procedure BaumAufbauen (var outWurzel : tRefBinBaum) ;
   var 
   index,
   Zahl : integer;
   elter, neuerKnoten : tRefBinBaum; 
   
   function KnotenVonIndex (baum : tRefBinBaum; index : integer) : tRefBinBaum;
   var
   elter : tRefBinBaum;
   begin
   if (index = 1) then
   KnotenVonIndex := baum
   else
   begin
   elter := KnotenVonIndex(baum, index div 2);
   if ( (index mod 2 ) = 0 ) then
   KnotenVonIndex := elter^.links
   else
   KnotenVonIndex := elter^.rechts
   end;
   end;
 begin
   read (index);
 new (outWurzel);
   read (Zahl);
   outWurzel^.Wert := Zahl;
 read (index);
   while (index <> 0) do
   begin 
   elter := KnotenVonIndex(outWurzel, index div 2);
   
   new (neuerKnoten);
   read (Zahl); 
   neuerKnoten^.Wert := Zahl; 
 if ( (index mod 2 ) = 0 ) then
   elter^.links := neuerKnoten
   else
   elter^.rechts := neuerKnoten;
   
   read (index); 
   end; 
   end; { BaumAufbauen }
 
begin
   writeln('Bitte Baum in level-order eingeben Eingabeformat: Immer erst der Index eines Knotens, dann dessen Wert:');
   BaumAufbauen (Wurzel);
   
   blaetterSindMax := BlattMax(Wurzel, 1);
   
   if blaetterSindMax then
   writeln ('Alle Blaetter sind groesser als alle Knoten auf den jeweiligen Pfaden zu ihnen.')
   else
   writeln ('Mind. ein Blatt ist nicht groesser als alle Knoten auf seinem Pfad.');
end. { TesteBBKnotenzahl }
 

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
   inRefWurzel^.Tiefe:= inTiefe;
   if ioMaxTiefe< inTiefe then
   ioMaxTiefe:= inTiefe;
   BerechneTiefeUndMaxTiefe(inRefWurzel^.links, inTiefe+1, ioMaxTiefe);
   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 }

Türme von Hanoi

program hanoi;
 uses crt;
   var i : integer;
   
   procedure han(anzahl: integer; von, ueber, nach : String); 
   begin
   if (anzahl = 1) then
   writeln('von ',von, ' nach ', nach)
   else
   begin
   han(anzahl-1, von, nach, ueber);
   han(1,von, ueber, nach);
   han(anzahl-1, ueber, von, nach);
   end;
   end;
   
   procedure tuermevonhanoi(i: integer);
   begin
   han(i, 'A', 'B','C');
   end;
BEGIN
   readln(i);
   tuermevonhanoi(i);
   
   END.

Forward-Deklaration

program forward;
uses crt;

var i : integer;

function b(i: integer) : string; forward;

function a(i: integer) : string;
begin
if (i=0) then
a:= ''
else
a := b(i-1) + 'a';
end;

function b(i: integer) : string;
begin
if (i=0) then
b:= ''
else
b := a(i-1) + 'b';
end;
BEGIN
readln(i);
writeln(a(i));

END.