In Liste suchen und gefundenes Element nach vorne bringen
program liste (input,output); type tRefElement = ^tElement; tElement = record info : integer; next : tRefElement; end; var listenanfang : tRefElement; zeiger : tRefElement; endeListe : tRefElement; eingabe : integer; gefunden:boolean; procedure alleDrucken(zuDrucken: tRefElement); var zeiger: tRefElement; begin zeiger := zuDrucken; while zeiger <> nil do begin write(zeiger^.info,' '); zeiger:= zeiger^.next; end; writeln; end; procedure NachVorn( inWert: integer; var ioRefAnfang: tRefElement); var zeiger1, zeiger2: tRefElement; begin if ioRefAnfang^.info <> inWert then begin zeiger1:= ioRefAnfang; zeiger2:= ioRefAnfang^.next; while zeiger2^.info<> inWert do begin zeiger1:= zeiger1^.next; zeiger2:= zeiger2^.next; end; zeiger1^.next:= zeiger2^.next; zeiger2^.next:= ioRefAnfang; ioRefAnfang := zeiger2; end; end;
BEGIN
listenanfang := nil;
writeln('Eingabe der Zahlen, Beenden mit 0');
readln(eingabe);
while eingabe <> 0 do
begin
new(zeiger);
zeiger^.info := eingabe;
zeiger^.next:=nil;
if listenanfang = nil then
listenanfang := zeiger
else
endeListe^.next:=zeiger;
endeListe := zeiger;
readln(eingabe);
end;
alleDrucken(listenanfang);
readln(eingabe);
NachVorn(eingabe, listenanfang);
alleDrucken(listenanfang);
END.
In binärem Baum nach dem Knoten mit einem bestimmten Index suchen
Lösung 1 und 2:
program Binaerbaum (input, output);
{Verwaltet einen Binärbaum}
const
NULL=0;
EINS=1;
F=false;
T=true;
type
tRefBinBaum= ^tBinBaum;
tBinbaum= record
info: integer;
links:tRefBinBaum;
rechts:tRefBinBaum;
end;
var
wurzel : tRefBinBaum;
Zahl: integer;
procedure einf(inWert:integer;
var ioBaum:tRefBinBaum);
{fügt inWert als neuen Knoten in den Baum ein}
var
Zeiger: tRefBinBaum;
begin
if ioBaum=nil then
{Baum ist noch leer}
begin
new(Zeiger);
Zeiger^.info:=inWert;
Zeiger^.links:=nil;
Zeiger^.rechts:=nil;
ioBaum:=Zeiger;
end
else
begin
if inWert <= ioBaum^.info then
{Wert links einfügen}
begin
if ioBaum^.links=nil then
{einfügen}
begin
new(Zeiger);
Zeiger^.info:=inWert;
Zeiger^.links:=nil;
Zeiger^.rechts:=nil;
ioBaum^.links:=Zeiger;
end
else
{links weitersuchen}
einf(inWert, ioBaum^.links);
end;
if inWert > ioBaum^.info then
{Wert rechts einfügen}
begin
if ioBaum^.rechts=nil then
{einfügen}
begin
new(Zeiger);
Zeiger^.info:=inWert;
Zeiger^.links:=nil;
Zeiger^.rechts:=nil;
ioBaum^.rechts:=Zeiger;
end
else
{rechts weitersuchen}
einf(inWert, ioBaum^.rechts);
end;
end;
end;
function finden(inBaum:tRefBinBaum;
inWert:integer): boolean;
{sucht inWert im Baum und gibt true oder false zurück}
begin
if inBaum=nil then
{Knoten leer}
finden:=F
else
if inBaum^.info=inWert then
{Wert gefunden}
finden:=T
else
{links und rechts suchen}
finden:=finden(inBaum^.links,inWert) or finden(inBaum^.rechts,inWert);
end;
procedure drucken(inBaum:tRefBinBaum);
begin
if inBaum <> nil then
begin
drucken(inBaum^.links);
writeln(inBaum^.info);
drucken(inBaum^.rechts);
end;
end;
function KnotenVonIndex1 ( inBaum : tRefBinBaum;
inIndex : integer) : tRefBinBaum;
{findet den Knoten zum Binärbaumindex}
var
Potenz,Zaehler,lokIndex: integer;
Knoten: tRefBinBaum;
begin
Potenz:=1;
Zaehler:=0;
lokIndex:= inIndex;
Knoten:= inBaum;
while lokIndex>= Potenz do
begin
Potenz:=Potenz*2;
Zaehler:= Zaehler+1;
end;
Potenz:= Potenz div 2;
lokIndex:= lokIndex - Potenz;
Zaehler:= Zaehler-1;
while Zaehler>0 do
begin
Zaehler:=Zaehler-1;
Potenz:=Potenz div 2;
if lokIndex>= Potenz then
begin
Knoten:=Knoten^.rechts;
lokIndex:=lokIndex-Potenz;
end
else
Knoten:=Knoten^.links;
end;
KnotenVonIndex1:= Knoten;
end;
function KnotenVonIndex2 ( inBaum : tRefBinBaum;
inIndex : integer; inAktIndex: integer) : tRefBinBaum;
{ findet den Knoten zum Binärbaumindex }
var
Ergebnis: tRefBinBaum;
begin
if inBaum=nil then
KnotenVonIndex2 := nil
else
begin
if inIndex= inAktIndex then
KnotenVonIndex2:= inBaum
else
begin
Ergebnis := KnotenVonIndex2(inBaum^.links, inIndex, inAktIndex*2);
if Ergebnis=nil then
Ergebnis := KnotenVonIndex2(inBaum^.rechts, inIndex, inAktIndex*2+1);
KnotenVonIndex2:= Ergebnis;
end;
end;
end;
BEGIN
{Baum aufbauen}
wurzel:=nil;
einf(NULL, wurzel);
einf(EINS , wurzel);
einf(9, wurzel);
einf(5, wurzel);
einf(3, wurzel);
einf(10, wurzel);
einf(EINS, wurzel);
for Zahl:= 20 to 30 do
begin
einf(Zahl, wurzel);
{Zahl := Zahl+1; ist auskommentiert}
end;
{Baum drucken}
drucken(wurzel);
writeln(KnotenVonIndex1(wurzel, 14)^.info);
writeln(KnotenVonIndex2(wurzel, 14,1)^.info);
END.
Lösung 3:
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;
procedure intervallSuche( inBaum: tRefBinBaum;
inMin, inMax:integer);
begin
if inBaum<>nil then
begin
intervallSuche(inBaum^.links,inMin,inMax);
if (inBaum^.info<=inMax) and (inBaum^.info >= inMin) then
writeln(inBaum^.info);
intervallSuche(inBaum^.rechts,inMin,inMax);
end;
end;
In Liste A Liste B suchen und aus A löschen, wenn gefunden
procedure Aufgabe3( inB:tRefElement;
var ioA:tRefElement);
var a1, a2, b, a0: tRefElement;
enthalten,fehler: boolean;
begin
{suche inB in ioA}
a0:=nil;
a1:= ioA;
enthalten:=false;
while (a1<>nil) and (not enthalten) do
begin
{durchlaufe A}
a2:= a1;
b:=inB;
fehler:= false;
while (b<>nil) and (a2<>nil) and (not fehler) do
begin
{durchlaufe B und vergleiche mit A ab Stelle a2}
if a2^.info<> b^.info then
fehler:=true
else
begin
b:=b^.next;
a2:=a2^.next;
end;
end;
if (b=nil) then
enthalten := true
else
a0:=a1;
a1:= a1^.next;
end;
{Umhängen}
if enthalten then
begin
if a0=nil then
ioA:= a2
else
a0^.next:=a2;
end;
end;
Fibonacci-Zahlen iterativ berechnen
program fibo;
type tNatZahl= 0..maxint;
var eingabe : tNatZahl;
function Fibonacci(n: tNatZahl): tNatZahl; var falt,fneu, fhilf , i: tNatZahl; begin if n=0 then Fibonacci:=0 else if n=1 then Fibonacci:=1 else begin falt:=0; fneu:=1; for i:= 2 to n do begin fhilf:=fneu; fneu:= falt+fneu; falt:=fhilf; end; Fibonacci:=fneu; end; end;
BEGIN readln(eingabe); writeln ( Fibonacci(eingabe)); END.
Alternative: Fibonacci-Zahlen rekursiv berechnen, aber effizient:
program fibo_rek;
type tRefPaar= ^tPaar; tPaar= record a,b:integer; end;
var n : integer; erg:tPaar;
function fibo(n:integer): tPaar; var erg: tPaar; begin if n=1 then begin fibo.a:=0; fibo.b:=1; end else if n=0 then begin fibo.a:=0; fibo.b:=0; end else begin erg:= fibo(n-1); fibo.a:=erg.b; fibo.b:=erg.a+erg.b; end; end;
BEGIN readln(n); erg:= fibo(n); writeln(erg.b); END.