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;