Rekurzió(k) - iteráció(k)

Tartalom

Tartalom.. 1

Alap rekurzív példák. 2

Feladat 2

Tételek rekurzív és iteratív megoldásai 4

Feladat 4

Az ‘Egyebek.inc’ betét 6

Az ‘Időmérés.inc’ betét 6

Backtrack. 7

1. feladat 7

A ‘Vezer.inc’ betét 9

A ‘CursUnit.pas’ unit 10

2. feladat 11

QuickSort 13

Feladat 13

Koch Fraktál 15

Feladat 15

Alap rekurzív példák

Feladat

Az irodalomból ismert példák megvalósítása Turbo Pascal-ban figyelmünket két kérdésre összpontosítva: a rekurzív hívások száma, ill. a maximális veremmélység. Lássa működés közben: REKURZIO.EXE!

Program Rekurzio;
Uses Newdelay,Crt;
Var hivasSzam, aktMelyseg, maxMelyseg: LongInt;
N,K: Word;

Procedure Beolvas(kerdes:String;
Var egesz:Word; tol,ig:Integer);
Begin
If ig=-1 then ig:=MaxInt;
{$i-}
Repeat
Write(kerdes); Readln(egesz);
Until (IOResult=0) and (egesz in [tol..ig]);
{$i+}
End;

Procedure Kiir(szoveg:String; ertek:LongInt);
Begin
If ertek=-1 then {nincs érték!}
Begin
HighVideo; Writeln(#13#10,szoveg);
NormVideo;
Writeln(' hívásszám:',hivasSzam:8,',
max.mélység:',maxMelyseg:8);
End

Else
Begin
HighVideo; Writeln(szoveg,ertek:8);
NormVideo;
Writeln(' hívásszám:',hivasSzam:8,',
max.mélység:',maxMelyseg:8);
End;
ReadKey;
End;

Function Szov(ertek: Word):String;
Var szoveg:String;
Begin
Str(ertek,Szoveg);
Szov:=szoveg
End;

{ ---------- Faktoriális sorozat ---------- }

Function Fakt(n:LongInt):LongInt;
Begin
Inc(hivasSzam); Inc(aktMelyseg);
If aktMelyseg>maxMelyseg then
maxMelyseg:=aktMelyseg;
If n=0 then Fakt:=1 else Fakt:=n*Fakt(n-1);
Dec(aktMelyseg)
End;

{ -------- Fibonacci sorozat --------------- }

Function Fibo(n:Word):LongInt;
Begin
Inc(hivasSzam); Inc(aktMelyseg);
If aktMelyseg>maxMelyseg then
maxMelyseg:=aktMelyseg;
If n in [0..1] then
Fibo:=1
else
Fibo:=Fibo(n-1)+Fibo(n-2);
{EndIf}
Dec(aktMelyseg)
End;

{ -------- Binomiális együtthatók ---------- }

Function BinomP(n,k:Word):LongInt;
Begin
Inc(hivasSzam); Inc(aktMelyseg);
If aktMelyseg>maxMelyseg then
maxMelyseg:=aktMelyseg;
If (n=0) or (k=0) or (n=k) then
BinomP:=1
else
BinomP:=BinomP(n-1,k)+BinomP(n-1,k-1);
{EndIf}
Dec(aktMelyseg)
End;

Function BinomS(n,k:Word):LongInt;
Begin
Inc(hivasSzam); Inc(aktMelyseg);
If aktMelyseg>maxMelyseg then
maxMelyseg:=aktMelyseg;
If (k>0) and (k<=n) then
BinomS:=((n-k+1)*BinomS(n,k-1)) div k
else
BinomS:=1;
{EndIf}
Dec(aktMelyseg)
End;

{ ------------- Hanoi tornyai -------------- }

Type PalcikaT = (Bal, Kozep, Jobb);
Const PalcikaS : Array [PalcikaT] of
String[5]=
(' Bal ', 'Kozep', 'Jobb ')

Procedure Hanoi(rol,val,ra:PalcikaT; n:Byte);
Begin
Inc(hivasSzam);
Inc(aktMelyseg);
If aktMelyseg>maxMelyseg then
maxMelyseg:=aktMelyseg;
If n>0 then
Begin
Hanoi(rol,ra,val,n-1);
Write(PalcikaS[rol]+'->'+
PalcikaS[ra]+';':20);
Hanoi(val,rol,ra,n-1);
End;
Dec(aktMelyseg)
End;

Begin
ClrScr; Writeln('Rekurziók':44);
Beolvas('N:',N,0,12);
aktMelyseg:=0; maxMelyseg:=0; hivasSzam:=0;
Kiir('Fakt('+szov(N)+'):',Fakt(N));
aktMelyseg:=0; maxMelyseg:=0; hivasSzam:=0;
Kiir('Fibo('+szov(N)+'):',Fibo(N));
Beolvas('K:',K,0,N);
aktMelyseg:=0; maxMelyseg:=0; hivasSzam:=0;
Kiir('BinomP('+szov(N)+','+szov(K)+'):',
BinomP(N,K));
aktMelyseg:=0; maxMelyseg:=0; hivasSzam:=0;
Kiir('BinomS('+szov(N)+','+szov(K)+'):',
BinomS(N,K));
aktMelyseg:=0; maxMelyseg:=0; hivasSzam:=0;
Hanoi(Bal,Kozep,Jobb,N);
Kiir('Hanoi('+szov(N)+'):',-1{Nem érdekes});
End.

Tételek rekurzív és iteratív megoldásai

Feladat

Az ‘lineáris eldöntés’ és ‘~ keresés’, a ‘logaritmikus eldöntés’, ill. a ‘maximum kiválasztásos rendezés’ rekurzív és iteratív változatának összehasonlítása. Az összehasonlítás a tényleges végrehajtási idő és a ciklusok összvégrehajtási száma alapján történik. (A tényleges végrehajtási idő pontosabb mérése érdekében érdemes többször lefuttatni –természetesen– ugyanazon körülmények között, s ennek idejéből számítani az egyszeri végrehajtási időt.) Mielőtt elemezné, lássa működés közben: REKITE.EXE!

Program RekurziokIteraciok;
{$M 65520,0,655360 - stack size, heap low, -upper limit}
Uses Newdelay,Crt,Dos;
Const
MaxN=3000; Enter=#13; Space=#32;
{gépfüggő ismétlési konstansok:}
LEldont=1000000; LLogKer=1000000; Lrendezes=15000000;
{Figyelem: ha túl kevés a végrehajtási idő, akkor teljesen fals a belső óra mérése!
A fentiek Pentium 120 Mz esetén jók.}

Type
Elem=LongInt;
Tomb=Array [1..MaxN] of Elem;
Var
N: Integer;
Y,X : Tomb; {Rendezéshez}
mit : Elem; VanE: Boolean; {Eldöntéshez,Keresésekhez}
i,L : LongInt; {ismétlési ciklushoz}
Nos : Char;
CiklusSzam: LongInt;

{$i idomeres.inc} {$i egyebek.inc}

Function EldontRek(Y:Elem; n:Integer
{; X:Tomb}):Boolean;
Begin
Inc(CiklusSzam);
If
n=0 then EldontRek:=False else if
Y=X[n] then EldontRek:=True
else EldontRek:=EldontRek(Y,n-1)
{EndIf};
End; {EldontRek}

Function EldontIte(Y: Elem; n: Integer
{; X: Tomb}): Boolean;
Var k: Integer;
Begin
Inc(CiklusSzam);
k:=n;
While (k>0) and (Y<>X[k]) do
Begin
Dec(k);
Inc(CiklusSzam);
End;
EldontIte:=k>0
End; {EldontIte}

Procedure KeresRek(Y:Elem; n:Integer{; X:Tomb};
Var Van:Boolean; Var sorsz:Integer);
Begin
Inc(CiklusSzam);
If
n=0 then
Begin
Van:=False; {sorsz:=Barmi}
End else if
Y=X[n] then
Begin
Van:=True; sorsz:=n
End
else Begin KeresRek(Y,n-1,Van,sorsz); End
{EndIf};
End; {KeresRek}

Procedure KeresIte(Y:Elem; n:Integer{; X:Tomb};
Var Van:Boolean; Var sorsz:Integer);
Var k: Integer;
Begin
Inc(CiklusSzam);
k:=n;
While (k>0) and (Y<>X[k]) do
Begin
Dec(k);
Inc(CiklusSzam);
End;
Van:=k>0;
If Van then sorsz:=k
End; {KeresIte}

Function LogDontRek(Y:Elem; e,u:Integer
{;X:Tomb}):Boolean;
Var k: Integer;
Begin
Inc(CiklusSzam); k:=(e+u) Div 2;
If
u<e then LogDontRek:=False else if
Y=X[k] then LogDontRek:=True else if
Y<X[k] then LogDontRek:=LogDontRek(Y,e,k-1)
else LogDontRek:=LogDontRek(Y,k+1,u)
{EndIf};
End; {LogDontRek}

Function LogDontIte(Y:Elem; e,u:Integer
{; X:Tomb}):Boolean;
Var k: Integer;
Begin
Inc(CiklusSzam); k:=(e+u) Div 2;
While (u>=e) and (Y<>X[k]) do
Begin
Inc(CiklusSzam);
If Y<X[k] then u:=k-1
else e:=k+1;
k:=(e+u) Div 2;
End;{While};
LogDontIte:=e<=u;
End; {LogDontIte}

{ félrekurzív változat }
Function MaxIndex(N:Integer{; X:Tomb}):Integer;
Var j,maxj: Integer;
Begin
maxj:=1;
For j:=2 to N do
Begin
If X[maxj]<X[j] then maxj:=j;
Inc(CiklusSzam);
End;
MaxIndex:=maxj
End; {MaxIndex}

Procedure MaxRendRek(N: Integer {;X:Tomb});
Var i: Integer; seged: Elem;
Begin
If N>1 then
Begin
i:=MaxIndex(N{,X});
seged:=X[N]; X[N]:=X[i]; X[i]:=seged;
MaxRendRek(N-1{,X})
End;
End; {MaxRendRek}

Procedure MaxRendIte(N: Integer {;X:Tomb});
Var i,j,maxj: Integer; seged: Elem;
Begin
For i:=1 to N-1 do
Begin
maxj:=i;
For j:=i+1 to N do
Begin
If X[maxj]<X[j] then maxj:=j;
Inc(CiklusSzam);
End;
seged:=X[i]; X[i]:=X[maxj]; X[maxj]:=seged;
End;
End; {MaxRendIte}

Begin
{ A vizsgált sorozat: }
UjLap('Iteráció - rekurzió.');
Sorozat;

{ ------------------- Eldöntés --------------- }
Repeat
UjLap('Lineáris eldöntés.');
KeresettElem(mit);
L:=(LEldont Div N)+1; {ismétlési szám}
OraIndulj;
For i:=1 to L do
Begin
VanE:=EldontRek(mit,N{,X});
End;
OraAllj;
Writeln('Rekurzióval: ',VanE);
Writeln(' Ideje:',IdoTartam/L:8:5,
' CiklusSzam:',CiklusSzam/L:6:0);
OraIndulj;
For i:=1 to L do
VanE:=EldontIte(mit,N{,X});
OraAllj;
Writeln('Iterációval: ',VanE);
Writeln(' Ideje:',IdoTartam/L:8:5,
' CiklusSzam:',CiklusSzam/(L):6:0);
Varj(Nos);
Until Nos=Space;

{ ------------------- Keresés ---------------- }
Repeat
UjLap('Lineáris keresés.');
KeresettElem(mit);
L:=(LEldont Div N)+1; {ismétlési szám}
OraIndulj;
For i:=1 to L do
KeresRek(mit,N{,X},VanE,sorsz);
OraAllj;
Writeln('Rekurzióval:',VanE,
'sorszám:',sorsz);
Writeln(' Ideje:',IdoTartam/L:8:5,
' CiklusSzam:',CiklusSzam/L:6:0);
OraIndulj;
For i:=1 to L do
KeresIte(mit,N{,X},VanE,sorsz);
OraAllj;
Writeln('Iterációval:',VanE,
'sorszám:',sorsz);
Writeln(' Ideje:',IdoTartam/L:8:5,
' CiklusSzam:',CiklusSzam/(L):6:0);
Varj(Nos);
Until Nos=Space;

{ ---------- Logaritmikus eldöntés --------- }
Repeat
UjLap('Logaritmikus eldöntés.');
KeresettElem(mit);
L:=LLogKer Div Round(Ln(N)); {ismétlési szám}
OraIndulj;
For i:=1 to L do
VanE:=LogDontRek(mit,1,N{,X});
OraAllj;
Writeln('Rekurzióval: ',VanE);
Writeln(' Ideje:',IdoTartam/L:8:5,
' CiklusSzam:',CiklusSzam/L:6:0);
OraIndulj;
For i:=1 to L do
VanE:=LogDontIte(mit,1,N{,X});
OraAllj;
Writeln('Iterációval: ',VanE);
Writeln(' Ideje:',IdoTartam/L:8:5,
' CiklusSzam:',CiklusSzam/(L):6:0);
Varj(Nos);
Until Nos=Space;

{ ----- Maximumkiválasztásos rendezés -------- }
Repeat
UjLap('Maximumkiválasztásos rendezés'+
'csökkenőre.');
OraIndulj;
L:=Round(LRendezes/N/N)+1; {ismétlési szám}
For i:=1 to L do
MaxRendRek(N{,X});
OraAllj;
Writeln('Rekurzióval: ');
Writeln(' Ideje:',IdoTartam/L:8:5,
' CiklusSzam:', CiklusSzam/L:6:0);
X:=Y; {eredeti helyzet visszaállítása}
OraIndulj;
For i:=1 to L do
MaxRendIte(N{,X});
OraAllj;
Writeln('Iterációval: ');
Writeln(' Ideje:',IdoTartam/L:8:5,
' CiklusSzam:', CiklusSzam/L:6:0);
Varj(Nos);
X:=Y; {eredeti helyzet visszaállítása}
Until Nos=Space;

End.

Az ‘Egyebek.inc’ betét

Procedure UjLap(s: String);
Begin
ClrScr;
HighVideo; Writeln(s:40+(Length(s) Div 2));
NormVideo;
End; {UjLap}

Procedure Varj(Var nos: Char);
Begin
GotoXY(35,25);
HighVideo; Write('Space-re kilép.');
NormVideo; Nos:=ReadKey;
End;

Procedure Sorozat{(Var X: Tomb)};
Var i: LongInt;
Begin
Repeat
Write('Sorozathossz:'); Readln(N);
Until (N>10) and (N<=MaxN);
X[1]:=Random(N); {kiinduló érték}
If N<100 then {ha 100-nál kevesebb, kiírjuk}
Write(1:6,'.:',X[1]:8);
For i:=2 to N do
Begin
X[i]:=X[i-1]+Random(Round(N))+2; {legalább
2-vel odébb!}
Y[i]:=X[i];
If N<100 then
Write(i:6,'.:',X[i]:8);
End;
If N<100 then
Begin
GotoXY(35,25); Write('Space-re tovább.');
Nos:=ReadKey;
End;
End; {Sorozat}
Procedure KeresettElem(Var mit: Elem);
Var i: LongInt;
Begin
Writeln; Write('A keresettet megtaláljuk?');
Nos:=ReadKey;
Write(Nos);
i:=Random(N Div 3)+1;
If UpCase(Nos)='I' then
Begin
mit:=X[i];
Writeln(' Mit:',mit,', sorszáma:',i,'.');
End
else
Begin
mit:=X[i]+1;
Writeln(' Mit:',mit,'=X(',i,')+1');
End;
End; {KeresettElem}

Az ‘Időmérés.inc’ betét

Var
KezdoIdo,VegIdo: LongInt;
IdoTartam: Real;

Procedure OraIndulj;
Var o,p,mp,szmp: Word;
Begin
GetTime(o,p,mp,szmp);
KezdoIdo:=Round(szmp+100*
(mp+60*(p+60.0{REAL!}*o)));
CiklusSzam:=0;
End; {OraIndulj}

Procedure OraAllj;
Var o,p,mp,szmp: Word;
Begin
GetTime(o,p,mp,szmp);
VegIdo:=Round(szmp+100*
(mp+60*(p+60.0{REAL!}*o)));
IdoTartam:=VegIdo-KezdoIdo;
End; {OraAllj}

Backtrack

1. feladat

A ‘Backtrack’ rekurzív átiratának elkészítése. Az unos-untig használt sablon a következő (’Eldöntés’/’Lin. keresésé’) tétel átalakítása alapján könnyen megérthető:

Iteratív

Rekurzív

Eljárás LinKer(Konstans x:TSorozat; Változó Van:Logikai,melyik:Egész): Változó i:Egész i:=1 Ciklus amíg i£N és nem T(x,i) i:+1 Ciklus vége Van:=i£N Ha Van akkor melyik:=i Eljárás vége.

A ciklust jobb rekurzióvá alakíthatjuk, miután különválasztottuk (egy önálló eljárásba) az „előkétől” és az „utókától”. Az eredeti eljárás paraméterei közül elegendő azokat „átvinni” a rekurzív eljárás paraméterei közé, amelyektől a ciklus valójában függ. Gondoskodni kell arról, hogy az utóka is a megfelelő információt megkapja. Erre sok mód lehet. Most a legkézenfekvőbbet válasszuk: legyen a rekurzív tevékenység egy index értékű függvény. Eljárás LinKer(Konstans x:TSorozat; Változó Van:Logikai,melyik:Egész): Változó i:Egész i:=1 i:=LinKerR(i,x)[1] Van:=i£N Ha Van akkor melyik:=i Eljárás vége. A ciklus jobb rekurzióvá alakítása: Függvény LinKerR(Konstans i:Egész, x:TSorozat):Egész Elágazás i>N esetén EldöntR:=i nem T(x,i) esetén EldöntR:=LinKerR(i+1,x) egyéb esetben EldöntR:=i Elágazás vége Függvény vége.

Alábbiakban a backtrack iskolapéldáját demonstráló programot adjuk meg iteratívan és rekurzívan. Mielőtt elemezné, lássa működés közben: VEZERDEMO.EXE. (Az azonos részeket csak egyszer adjuk meg.)

Iteratív	Rekurzív
Program N_Vezer{Iteratív backtrack}; Uses Newdelay,Crt,Graph,CursUnit; Const MaxN = 10; Type Index = 0..MaxN+1; MIndex= -1..MaxN+1; Tabla = Array [1..MaxN] of (Ures,Foglalt); Hol = Array [1..MaxN] of Index; Var Vezer : Hol; i: MIndex; N,j, hova : Index; lehet : Boolean; {$I Vezer.inc}
Function Uti(vx1,vy1, vx2,vy2: Index): Boolean; Begin Uti:=(vy1=vy2) or (Abs(vy1-vy2)=vx1-vx2) End; {Uti}
Function RosszEset(x,y: Index): Boolean; Var j: Index; Begin Letesz(x,y,True); j:=1; While (j<=x-1) and not uti(x,y, j,Vezer[j]) do Begin Inc(j); End; Varakozas(1); Folvesz(x,y); RosszEset:=j<=x-1 End;	Function RosszEset(x,y: Index): Boolean; Function RosszEsetR(j,x,y: Index): Boolean; Begin If j>x-1 then Begin RosszEsetR:=False End else If not uti(x,y, j,Vezer[j]) then RosszEsetR:=RosszEsetR(j+1,x,y) else RosszEsetR:=True {EndIf}; End; Begin Letesz(x,y,True); RosszEset:=RosszEsetR(1,x,y); {az adminisztráció nélküli, rekurzív rész meghívása} Varakozas(1); Folvesz(x,y); End;
Procedure VanJoEset(i: Index; Var talan: Boolean; Var ide: Index); Begin ide:=Vezer[i]+1; While (ide<=N) and RosszEset(i,ide) do Inc(ide); talan:=ide<=N; End;	Procedure VanJoEset(i: Index; Var talan: Boolean; Var ide: Index); Procedure VanJoEsetR(i: Index; Var talan: Boolean; Var ide: Index); Begin If ide>N then talan:=False else if RosszEset(i,ide) then Begin Inc(ide); VanJoEsetR(i,talan,ide) End else talan:=True; {EndIf} End; Begin ide:=Vezer[i]+1; VanJoEsetR(i,talan,ide); End;
Procedure BackTrack; Begin i:=1; For j:=1 to N do Vezer[j]:=0; While i in [1..N] do Begin Varakozas(2); VanJoEset(i,lehet,hova); If lehet then Begin Letesz(i,hova,False); Vezer[i]:=hova; Inc(i); End else Begin Vezer[i]:=0; Dec(i); If i>0 then Begin Folvesz(i,Vezer[i]); End; End; End; If i>0 then VanMegoldas(N) else NincsMegoldas(N); End;	Procedure BackTrack; Function BackTrackR(i:MIndex):Boolean; Begin If i<1 then BackTrackR:=False else if i>N then BackTrackR:=True else Begin Varakozas(2); VanJoEset(i,lehet,hova); If lehet then Begin Letesz(i,hova,False); Vezer[i]:=hova; Inc(i); End else Begin Vezer[i]:=0; Dec(i); If i>0 then Begin Folvesz(i,Vezer[i]); End; End; BackTrackR:=BackTrackR(i); End; {EndIf}; End; Begin i:=1; For j:=1 to N do Vezer[j]:=0; If BackTrackR(i) then VanMegoldas(N) else NincsMegoldas(N); End;
Begin Inicializalas(N); CurOff; BackTrack; CurOn; End.

A ‘Vezer.inc’ betét

{ megjelenítési paraméterek: }

Var

bfx,bfy,

jax,jay: Integer; {táblasarkak}

mOldal : Integer; {egy mezô oldalának hossza}

Procedure Varakozas(meddig: Integer);

Var

c: Char;

Begin

If meddig<=0 then

Begin

Repeat Until KeyPressed; c:=ReadKey;

End

else

Begin

Delay(meddig*1000);

If KeyPressed then

Begin

c:=ReadKey;

Repeat Delay(1000); Until KeyPressed;

c:=ReadKey;

End;

End;

End; {Várakozás}

Procedure MezoRajz(x,y: Integer; szin: Integer);

Begin

Window(bfx+2*mOldal*(x-1),bfy+mOldal*(y-1),bfx+2*mOldal*x-1,bfy+mOldal*y-1);

TextBackGround(szin); ClrScr;

End; {MezôRajz}

Procedure BabuRajz(x,y: Integer; hszin,bszin: Integer);

Var

balx,baly: Integer;

Begin

balx:=bfx+2*mOldal*(x-1); baly:=bfy+mOldal*(y-1);

Window(balx,baly,balx+2*mOldal-1,baly+mOldal-1);

TextBackGround(hszin); TextColor(bszin);

GotoXY(mOldal,(mOldal Div 2)+1); Write('_'{=2});

End; {BábuRajz}

Procedure Inicializalas(Var n: Index);

Var

i,j: Integer;

Begin

Window(1,1, 80,25); TextColor(White); TextBackGround(Black); ClrScr;

Writeln('N-vezérprobléma':48);

Repeat

GotoXY(1,5); Write('Vezérszám (1<N<',MaxN:2,'):'); Readln(n)

Until n in [2..MaxN];

Window(1,2, 80,25); ClrScr;

mOldal:=22 Div n;

bfy:=2+(22 Div n) Div 2; jay:=bfy+n*mOldal-1;

bfx:=(80-2*n*mOldal) Div 2; jax:=bfx+2*n*mOldal;

Window(bfx-1,bfy-1, jax+1,jay+1); TextColor(White); TextBackGround(Brown); ClrScr;

Window(1,1, 80,25); {Ablakvisszaállítás}

For i:=1 to n do For j:=1 to n do

Begin

If ((i+j) Mod 2)=0 then MezoRajz(i,j,White) else MezoRajz(i,j,Black);

End

End;

Procedure Letesz(i,j: Index; proba:Boolean);

Begin

If proba then

If ((i+j) Mod 2)=0 then BabuRajz(i,j,White,Red)

else BabuRajz(i,j,Black,Yellow)

Else

If ((i+j) Mod 2)=0 then BabuRajz(i,j,White,Black)

else BabuRajz(i,j,Black,White);

End; {Letesz}

Procedure Folvesz(i,j: Index);

Begin

If ((i+j) Mod 2)=0 then MezoRajz(i,j,White) else MezoRajz(i,j,Black);

End; {Folvesz}

Procedure VanMegoldas(n: Index);

Var

i,j: Index;

Begin

Window(1,1, 80,25); TextColor(White); TextBackGround(Black); ClrScr;

Write('Az N-vezérproblémának N=',n,' esetre van megoldása, mégpedig az alábbi:');

Window(bfx-1,bfy-1, jax+1,jay+1); TextColor(White); TextBackGround(Brown); ClrScr;

Window(1,1, 80,25); {Ablakvisszaállítás}

For i:=1 to n do For j:=1 to n do

Begin

If ((i+j) Mod 2)=0 then

Begin

MezoRajz(i,j,White);

If Vezer[i]=j then BabuRajz(i,j,White,Black);

End

else

Begin

MezoRajz(i,j,Black);

If Vezer[i]=j then BabuRajz(i,j,Black,White);

End;

End;

Varakozas(0);

End;

Procedure NincsMegoldas(n: Index);

Begin

Window(1,1, 80,25); TextColor(White); TextBackGround(Black); ClrScr;

Write('Az N-vezérproblémának N=',n,' esetre nincs megoldása.');

Varakozas(0);

End;

A ‘CursUnit.pas’ unit

Unit CursUnit;

Interface

Procedure CurOn;

Procedure CurOff;

Implementation

Var Cursor : Word;

Procedure CurOn; Assembler;

Asm

mov ah,01h

mov cx,Cursor

int 10h

End; {CurOn}

Procedure CurOff; Assembler;

Asm

mov ah,03h

mov bh,00h

int 10h

mov Cursor, cx

mov ah,01h

mov cx,65535

int 10h

End; {CurOff}

Begin

End.

2. feladat

A ‘Backtrack’ fél rekurzív átiratának elkészítése a Mikrológia 4 7.4.3. fejezetbeli „kiválogatásos” megoldás alapján.

Fél rekurzív megoldás	Magyarázat
Program N_Vezer{Fél rekurzív backtrack}; { Az 'N-vezér probléma backtrack újraalkotása fél rekurzívvá' feladat. Kiinduló pont a Mikrológia 4 7.4.3. fejezetbeli kiválogatásos megoldás. -- Megoldás } Uses Newdelay,Crt,Graph,CursUnit; Const MaxN = 10; Type Index = 0..MaxN+1; MIndex= -1..MaxN+1; Tabla = Array [1..MaxN] of (Ures,Foglalt); Hol = Array [1..MaxN] of Index; Var Vezer : Hol; i: MIndex; N,j, hova : Index; lehet : Boolean; {$i Vezer.inc} {------------- lényegi eljárások ---------------} Function Uti(vx1,vy1, vx2,vy2:Index): Boolean; Begin Uti:=(vy1=vy2) or (Abs(vy1-vy2)=vx1-vx2) End; {Uti}	változatlan
Function RosszEsetR(x,y,j:Index): Integer; Begin If x=j then RosszEsetR:=j else if uti(x,y, j,Vezer[j]) then RosszEsetR:=j else RosszEsetR:=RosszEsetR(x,y,j+1) {End If} End; Function RosszEset(x,y:Index):Boolean; Var j: Index; Begin Letesz(x,y,True); j:=RosszEsetR(x,y,1); Varakozas(1); Folvesz(x,y); RosszEset:=j<=x-1 End;
Procedure BackTrackR(Const i,N:Integer; Var Vane:Boolean {Var Vezer:Hol}); Var j:Integer; Begin If i>N then Begin Vane:=True End else Begin j:=1; Vane:=False; While (j<=N) and not Vane do Begin If not RosszEset(i,j) then Begin Letesz(i,j,False); Vezer[i]:=j; BacktrackR(i+1,N,Vane); If not Vane then Folvesz(i,Vezer[i]); End; Inc(j) End; End; End; Procedure BackTrack; Var j:Integer; Begin For j:=1 to N do Vezer[j]:=0; BacktrackR(1,N,lehet); If lehet then VanMegoldas(N) else NincsMegoldas(N); End;
Begin Inicializalas(N); CurOff; BackTrack; CurOn; End.	változatlan

QuickSort

Feladat

A ‘QuickSort rendezés’ „alap” rekurzív (amelyben a ‘Szétválogatás’ iteratívan szerepelhet; REKQS.EXE), a fél-rekurzív (QS_FELRE.EXE) és az iteratív (ITERQS.EXE) változatának összevetése. Először a –közismert– rekurzív változatot tárgyaljuk.!

Program RekurzivQuickSort;
Uses Newdelay,Crt;
Const
N = 100;
Type
Index=1..N; IndexM=0..N+1;
Intervallum=Record eleje,vege:IndexM End;
Var
tomb : Array [Index] of Integer;
szakasz,masikszakasz : Intervallum;
kozep : IndexM;

Const
KezdoSzakasz:Intervallum=(eleje:1; vege:N);

Procedure TombInic;
Var i : Integer; c : Char;
Begin
LowVideo; Window(16,2,55,15);
Writeln('A rendezetlen vektor:');
For i:=1 to N do
Begin
tomb[i]:=Random(N); Write(tomb[i]:4)
End;
c:=ReadKey;
End; {TombInic}

Procedure TombKiir;
Var i : Integer; c : Char;
Begin
HighVideo; Window(16,14,55,25);
Writeln('A rendezett vektor:');
For i:=1 to N do
Begin Write(tomb[i]:4) End;
c:=ReadKey;
End; {TombKiir}

Function Uresszakasz(sz:Intervallum):Boolean;
Begin
UresSzakasz:=(sz.vege-sz.eleje)<1
End; {UresSzakasz}

Procedure Szetvalogat(sz:Intervallum;
Var k:Index);
Var seged : Integer; bal,jobb : IndexM;
Begin
bal:=sz.eleje; jobb:=sz.vege;
seged:=tomb[bal];
While bal<jobb do
Begin
While (bal<jobb) and (tomb[jobb]>=seged) do
Dec(jobb);
If bal<jobb then
Begin
tomb[bal]:=tomb[jobb]; Inc(bal)
End;
While (bal<jobb) and (tomb[bal]<=seged) do
Inc(bal);
If bal<jobb then
Begin
tomb[jobb]:=tomb[bal]; Dec(jobb)
End;
End;
tomb[bal]:=seged;
k:=bal
End; {Szetvalogat}

Procedure rQS(sz: Intervallum);
Var kozep:Index; szM:Intervallum;
Begin
Szetvalogat(sz,kozep);
szM.eleje:=sz.eleje; szM.vege:=kozep-1;
If not UresSzakasz(szM) then rQS(szM);
szM.eleje:=kozep+1; szM.vege:=sz.vege;
If not UresSzakasz(szM) then rQS(szM);
End;

Begin
ClrScr;
TombInic; szakasz:=KezdoSzakasz;
rQS(szakasz);
TombKiir
End.

Másodikként a félig rekurzív megoldást nézzük meg. Az átírás lényegét az alábbi sémával közelíthetjük meg:

Az absztrakt rekurzív eljárás:	Vezessük be az alábbi eljárást:	Vagyis az A eljárás B-vel rövidített alakban:	Így az ekvivalens megoldás:
Eljárás A(x…): y:=f(x) Ha p(y) akkor A(y) y:=g(x) Ha q(y) akkor A(y) Eljárás vége.	Eljárás B(x,y…): y:=f(x) Ha p(y) akkor A(y) y:=g(x) Eljárás vége.	Eljárás A(x…): B(x,y) Ha q(y) akkor A(y) Eljárás vége.	Eljárás A(x…): B(x,y) Ciklus amíg q(y) B(y,y) Ciklus vége Eljárás vége.

A fenti „sémát” alkalmazva, s elvégezve a pontosítást, kapjuk az alábbit:

Procedure FelrekQS(sz: Intervallum); Var kozep: Index; szM : Intervallum; Begin
Szetvalogat(sz,kozep); szM.eleje:=sz.eleje; szM.vege:=kozep-1; If not UresSzakasz(szM) then FelrekQS(szM); szM.eleje:=kozep+1; szM.vege:=sz.vege;	x y B(sz.eleje,szM) [az sz.végé-től „globálisan” függ!]
While not UresSzakasz(szM) do Begin
Szetvalogat(szM,kozep); szM.eleje:=szM.eleje; szM.vege:=kozep-1; If not UresSzakasz(szM) then FelrekQS(szM); szM.eleje:=kozep+1; szM.vege:=sz.vege;[2]	B(szM.eleje,szM)
End; End; {FelrekQS}

Harmadikként az iteratív megoldást nézzük meg. Ennek „alappillére” a veremhasználat. (Csak a „változó” részeket írjuk le.)

Program IterativQuickSort;
Uses
Crt;
Const
N = 100; VMax = 100;
Type
Index=1..N; Mutato=0 {=sehova}..N+1{=sehova};
Intervallum=Record eleje, vege:Mutato End;
Var
verem:Array [1..VMax] of Intervallum;
vm : Mutato; {veremmutató}
tomb: Array [Index] of Integer;
Const
KezdoSzakasz:Intervallum=(eleje:1; vege:N);

Procedure Verembe(mit: Intervallum);
Begin
Inc(vm); verem[vm]:=mit
End; {verembe}

Procedure Verembol(Var mibe: Intervallum);
Begin
mibe:=verem[vm]; Dec(vm)
End; {Verembol}

Procedure VeremInic;
Begin
vm:=0
End; {VeremInic}

Function UresVerem: Boolean;
Begin
UresVerem:=(vm=0)
End; {UresVerem}

Az alábbi eljárások nem változnak:

Procedure TombInic; Function Uresszakasz(sz: Intervallum): Boolean;
Procedure TombKiir; Procedure Szetvalogat(sz: Intervallum; Var k: Index);

A lényeg:

Procedure iterQS(sz: Intervallum);

Var masikszakasz : Intervallum; kozep : Index;
Begin

{a híváskor megtörtént: TombInic; szakasz:=KezdoSzakasz;}
VeremInic; Verembe(szakasz);
While not UresVerem do
Begin
While not UresSzakasz(szakasz) do
Begin
Szetvalogat(szakasz,kozep);
masikszakasz.eleje:=kozep+1; masikszakasz.vege:=szakasz.vege;
Verembe(masikszakasz);
szakasz.vege:=kozep-1
End;
Verembol(szakasz)
End; TombKiir
End {iterQS}.

Koch Fraktál

Feladat

A ‘Koch-fraktál’ iteratív és rekurzív megvalósítása Turbo Pascal-ban. Mielőtt elemezné, lássa működés közben: KOCH_R_I.EXE!

Program KochFraktal; { Rekurzívan és kétféleképpen iteratívan }
Uses Graph3;
Var s,h,k,sz: Integer;

Procedure Inic;
Begin
HiRes; HiresColor(15);
Home; PenUp; TurnLeft(90); Forwd(150); TurnRight(180); PenDown;
End;

Procedure Koch(szint,hossz:integer);
Begin
If szint=0 then
Begin
Forwd(hossz)
End
Else
Begin
Koch(szint-1,hossz Div 3);
TurnLeft(60);
Koch(szint-1,hossz Div 3);
TurnRight(120);
Koch(szint-1,hossz Div 3);
TurnLeft(60);
Koch(szint-1,hossz Div 3);
End;
End;

Const
MaxMelyseg = 100;
Var
verem: Array [1..MaxMelyseg] of Record szint,kov,hossz,szog:Integer End;
vm : 0..MaxMelyseg;

Procedure VeremInic;
Begin
vm:=0;
End;

Procedure Verembol(Var szint,kov,
hossz,szog: Integer);
Begin
If vm>0 then
Begin
szint:=verem[vm].szint;
kov:=verem[vm].kov;
hossz:=verem[vm].hossz;
szog:=verem[vm].szog;
Dec(vm);
End
End;

Procedure Verembe(szint,kov,
hossz,szog: Integer);
Begin
If vm<MaxMelyseg then
Begin
Inc(vm);
verem[vm].szint:=szint;
verem[vm].kov:=kov;
verem[vm].hossz:=hossz;
verem[vm].szog:=szog;
End
End;

Function UresVerem: Boolean;
Begin
UresVerem:=vm=0
End;

Procedure KochI1(szint,hossz:integer);
Begin
VeremInic;
Verembe(szint,1,hossz,0);
While not UresVerem do
Begin
Verembol(s,k,h,sz);
If s>0 then
Begin
Case k of
1: Begin Verembe(s,k+1,h,+60); Verembe(s-1,1,h Div 3,sz); End;
2: Begin Verembe(s,k+1,h,-120); Verembe(s-1,1,h Div 3,sz); End;
3: Begin Verembe(s,k+1,h,+60); Verembe(s-1,1,h Div 3,sz); End;
4: Begin Verembe(s-1,1,h Div 3,sz); End;
End;
End
Else

Begin
TurnLeft(sz); Forwd(h);
End
End;
End;

Procedure KochI2(szint,hossz:integer);
Begin
VeremInic;
Verembe(szint, 1{ennek most nincs szerepe!!!}, hossz,0);
While not UresVerem do
Begin
Verembol(s, k{ennek most nincs szerepe!!!},h, sz);
If s>0 then
Begin
Verembe(s-1, 1,h Div 3, 60); Verembe(s-1, 1,h Div 3, -120);
Verembe(s-1, 1,h Div 3, 60); Verembe(s-1, 1,h Div 3, sz {!!!});
End
Else
Begin
TurnLeft(sz); Forwd(h);
End;
End;
End;

Begin
Inic; Koch(3,300); readln;
Inic; KochI1(4,300); readln;
Inic; KochI2(5,300); readln;
End.

---

[1] Egyszerűbben is írható: i:=1 i:=LinKerR(1,x)

[2] Ha a B inline eljárás az sz-től egészében (s nem csak az sz.elejé-től) függene, akkor itt el kellene térni a fenti sémától, hiszen akkor itt szM.vege:=szM.vege kellene legyen, ami hibás lenne.