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 }
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 }
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 }
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.
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.