Es soll geprüft werden, ob Liste b in Liste a vorkommt. Wenn ja, sollen die Elemente von b in a gelöscht werden.
Algorithmus:
prozedur Listenvergleich:
{input Liste a und b}
gefunden = false
a1 = erstes Element von a
while a1 <> nil and gefunden = false do
y = erstes Element von b
a2 = a1
gefunden = true
while y <> nil do
if a2=y then
a2 = Nachfolger von a2 in a
y = Nachfolger von y in b
if a2=nil and y <>nil then
gefunden = false
else
gefunden = false
end while
if gefunden = false then
a1 = Nachfolger von a1 in a
end while
if gefunden = true then
{Lösche in a ab a1 so viele Elemente, wie b hat}
a2 = ioA;
while Nachfolger von a2 <> a1 do
a2 = Nachfolger von a2
a3 = Nachfolger von a2
y= inB;
while y<>nil do
y = Nachfolger von y
a3 = Nachfolger von a3
Nachfolger von a2 = a3
Programm:
program Klausur2015Aufg3;
uses crt;
type tRefListe= ^tListe;
tListe = record
info: integer;
next: tRefListe;
end;
var a,b,neu, alt : tRefListe;
procedure Listenvergleich(var ioA: tRefListe; inB: tRefListe);
var
gefunden: boolean;
a1, a2, y, a3: tRefListe;
begin
gefunden:= false;
a1 := ioA;
while ((a1<>nil) and (gefunden=false)) do
begin
y := inB;
a2 := a1;
gefunden:= true;
while (y<>nil) and (gefunden=true) do
begin
if a2^.info=y^.info then
begin
a2 := a2^.next;
y := y^.next;
if (a2=nil) and (y<>nil) then
gefunden := false;
end
else
gefunden := false;
end;
if gefunden = false then
a1 := a1^.next;
end;
if gefunden then
begin
{Löschen}
a2 := ioA;
while a2^.next <> a1 do
a2 := a2^.next;
a3 := a2^.next;
y := inB;
while y<>nil do
begin
y := y^.next;
a3 := a3^.next;
end;
end;
a2^.next := a3;
end;
BEGIN new(a); a^.info:=2; a^.next:=nil; new(neu); neu^.info:=3; neu^.next:=nil; a^.next:= neu; alt:=neu; new(neu); neu^.info:=6; neu^.next:=nil; alt^.next:= neu; alt:=neu; new(neu); neu^.info:=1; neu^.next:=nil; alt^.next:= neu; alt:=neu; new(neu); neu^.info:=8; neu^.next:=nil; alt^.next:= neu; alt:=neu; new(neu); neu^.info:=4; neu^.next:=nil; alt^.next:= neu; alt:=neu; new(neu); neu^.info:=9; neu^.next:=nil; alt^.next:= neu; alt:=neu; new(neu); neu^.info:=10; neu^.next:=nil; alt^.next:= neu; new(b); b^.info:=6; b^.next:=nil; new(neu); neu^.info:=1; neu^.next:=nil; b^.next:= neu; alt:=neu; new(neu); neu^.info:=8; neu^.next:=nil; alt^.next:= neu; alt:=neu; new(neu); neu^.info:=4; neu^.next:=nil; alt^.next:= neu;
Listenvergleich(a,b); alt:= a; while alt<>nil do begin writeln(alt^.info); alt:=alt^.next; end; END.
Es soll geprüft werden, ob das Maximum jedes Pfades im Blatt liegt
program BaumMaxBlatt;
uses crt; type tRefBinbaum = ^tBinbaum; tBinbaum = Record info: integer; links,rechts: tRefBinbaum; end; var i : integer;
function aufg4(inWurzel: tRefBinbaum; inMax:integer) : boolean; var neuMax:integer; begin if inWurzel<>nil then begin if (inWurzel^.links=nil) and (inWurzel^.rechts=nil) then begin if inWurzel^.info >= inMax then aufg4:= true else aufg4:= false; end else begin if inWurzel^.info >= inMax then neuMax:=inWurzel^.info else neuMax:= inMax; aufg4:= aufg4(inWurzel^.links,neuMax) and aufg4(inWurzel^.rechts,neuMax); end; end else aufg4 := true; end;
BEGIN END.
program wurzel2;
{Eingabe: reelle Zahl a
Ausgabe: Wurzel der Zahl a in n-ter Näherung
nach dem Heron-Verfahren}
var a, w: real; n : integer;
BEGIN
{Eingabe reelle Zahl}
write('a: ');
readln(a);
{Eingabe Anzahl der Näherungsschritte}
write('n: ');
readln(n);
w:=1.0;
while n>0 do
begin
w:= 0.5 * (w + a/w);
n:= n-1;
end;
Writeln( w:10:4);
END.
Nicht mit fester Anzahl der Rechenschritte. Es wird berechnet, ob sich die Näherungswerte noch stark ändern
program wurzel3;
{Eingabe: reelle Zahl a
Ausgabe: Wurzel der Zahl a in n-ter Näherung
nach dem Heron-Verfahren}
var a, w, w0: real; n : integer;
BEGIN
{Eingabe reelle Zahl}
write('a: ');
readln(a);
w:=1.0;
w0:= 2.0;
n:=0;
while (abs(w0-w)> 0.001) do
begin
w0:= w;
w:= 0.5 * (w + a/w);
n:= n+1;
end;
Writeln( w);
writeln('berechnet in ',n,' Schritten');
END.
Aufgabe 2:
{ Entwurf }
program Aufgabe2(input,output);
{ Heron-Verfahren }
var
n, { Schrittanzahl (natuerliche Zahl) }
i, { Schrittzähler }
a: integer; { Operand (natuerliche Zahl) }
w: real; { aktueller Wert der Wurzelnäherung }
begin
{Nähere in n Schritten die Wurzel von a an.}
readln(a);
readln(n);
w:=1.0;
write(w:6:2);
for i := 2 to n do
begin
{Berechne Annäherungsschritt}
w:=0.5*(w+a/w);
write(w:6:2)
end;
end.
Alternative: rekursiv
program Aufgabe2(input,output);
{ Heron-Verfahren }
var
n,
a: integer;
function w(inA, inN:integer):real;
{ berechnet die Wurzel von a in n Schritten mit Ausgabe }
var
wAlt: real; { w_n-1 }
begin
if inN <= 1 then
w := 1.0
else
begin
wAlt := w(inA, inN-1); { Rekursion }
write(wAlt:6:2);
w := 0.5 * (wAlt + inA / wAlt );
end;
end;
begin { Hauptprogramm }
readln(a);
readln(n);
write(w(a,n):6:2);
end.
Aufgabe 3:
procedure Aufgabe3( inB:tRefListe;
var ioA:tRefListe);
{ Die Prozedur sucht das erste Vorkommen von der Liste B in der
Liste A und kettet diesen Teil aus der Liste A aus.
Ist die Liste B nicht in der Liste A enthalten,
bleibt die Liste A unverändert. }
var
aStart,
aLauf,
aAlt,
bLauf:tRefListe;
found:boolean;
begin
if (inB<>nil) and (ioA<>nil) then
begin
aStart:=ioA;
aAlt:=nil;
found:=false;
while (not found) and (aStart<>nil) do
{ Liste A durchlaufen bis Ende oder gefunden }
begin
aLauf:=aStart;
bLauf:=inB;
while (aLauf^.wert=bLauf^.wert) and (aLauf^.next<>nil)
and (bLauf^.next<>nil) do
{ Listen A und B parallel durchlaufen und vergleichen }
begin
aLauf:=aLauf^.next;
bLauf:=bLauf^.next;
end;
if (bLauf^.next=nil) and (aLauf^.wert=bLauf^.wert) then
found:=true { Schleifenabbruch }
else
begin { weiter in Liste A }
aAlt:=aStart;
aStart:=aStart^.next;
end;
end;
if found then { Fundstelle ausketten }
begin
if ioA=aStart then
ioA:=aLauf^.next
else
aAlt^.next:=aLauf^.next
end;
end;
end;
Alternative:
{ Lösung von Gerhard Gappmeier, 23.08.2015 20:52 }
procedure remove(inB : tRefList;
var ioA : tRefList);
{ Sucht Liste inB in Liste ioA und entfernt diese falls gefunden.
Ist inB nicht in ioA enthalten bleibt ioA unverändert.
}
var pos : tRefList; { Haupt iterator }
prev : tRefList; { Zeigt auf vorheriges Element }
posA : tRefList; { Hilfsvariable für Listenvergleich }
posB : tRefList; { Hilfsvariable für Listenvergleich }
gefunden : boolean;
begin
prev := NIL;
pos := ioA;
{ Über A iterieren um Teilliste B zu finden }
while pos <> NIL do
begin
gefunden := true;
posA := pos;
posB := inB;
{ Listen vergleichen }
while (posB <> NIL) and (gefunden) do
begin
if posA^.wert <> posB^.wert then
gefunden := false; { listen nicht identisch }
posB := posB^.next;
posA := posA^.next;
if (posA = NIL) and (posB <> NIL) then
gefunden := false; { vorzeitiges Ende von A }
end;
{ posA zeigt nun auf Element nach gefundener Teilliste }
if gefunden then
begin
if prev <> NIL then
prev^.next := posA { Teilliste entfernen }
else
ioA := posA { Listenanfang aktualisieren }
end;
prev := pos;
pos := pos^.next
end
end;
2. Alternative:
{ funktional zerlegte Lösung }
function istAnfang(inAnfang, inListe:tRefListe):Boolean;
{ true, wenn die Anfangsliste der Anfang der anderen Liste ist;
false, wenn die andere Liste zu kurz ist
oder sich Elemente unterscheiden }
var
Anfang, Liste: tRefListe;
gleich:Boolean;
begin
gleich := true;
Anfang := inAnfang;
Liste := inListe;
while (Anfang <> nil) and (Liste <> nil) and gleich do
begin
gleich:=(Anfang^.info = Liste^.info);
Anfang:=Anfang^.next;
Liste:=Liste^.next;
end;
istAnfang = (gleich and (Anfang = nil));
end;
procedure entketteAnfang(inAnfang:tRefListe;
var ioListe:tRefListe);
{ kettet den Anfang der Liste aus; inAnfang muss der Anfang sein }
var
Anfang: tRefListe;
begin
Anfang := inAnfang;
while Anfang <> nil do
begin
Anfang := Anfang^.next;
ioListe := ioListe^.next;
end;
end;
procedure entferneBausA(inB : tRefListe;
var ioA : tRefListe);
{ Sucht Liste inB in Liste ioA und entfernt diese ein Mal
(falls möglich). }
var
ZeigerA: tRefListe;
ungeloescht: Boolean;
begin
if istAnfang(inB, ioA) then
entketteAnfang(inB, ioA)
else
begin
ZeigerA := ioA;
ungeloescht := true;
while (ZeigerA <> nil) and ungeloescht do
begin
if istAnfang(inB, ZeigerA^.next) then
begin
entketteAnfang(inB, ZeigerA^.next);
ungeloescht = false;
end;
ZeigerA:=ZeigerA^.next;
end; {while}
end;
end;
Aufgabe 4:
function KnotenVonIndex ( baum : tRefBinBaum;
index : integer) : tRefBinBaum;
{ findet den Knoten zum Binärbaumindex }
var
elter : tRefBinBaum; { Zeiger auf Elternknoten }
begin
if (index = 1) then { Wurzel, Rekursionsabbruch }
KnotenVonIndex := baum
else
begin { Rekursion }
elter := KnotenVonIndex(baum, index div 2);
if ( (index mod 2 ) = 0 ) then
KnotenVonIndex := elter^.links
else
KnotenVonIndex := elter^.rechts
end;
end;