online kép - Fájl  tubefájl feltöltés file feltöltés - adja hozzá a fájlokat onlinefedezze fel a legújabb online dokumentumokKapcsolat
  
 

Letöltheto dokumentumok, programok, törvények, tervezetek, javaslatok, egyéb hasznos információk, receptek - Fájl kiterjesztések - fajltube.com

Online dokumentumok - kep
  
felso sarok kategória jobb felso sarok
 

Biológia állatok Fizikai Földrajz Kémia Matematika Növénytan Számítógépes
Filozófia
Gazdaság
Gyógyszer
Irodalom
Menedzsment
Receptek
Vegyes

 
bal also sarok   jobb also sarok
felso sarok   jobb felso sarok
 




































 
bal also sarok   jobb also sarok

Rekurzió (particiószam, Hanoi tornyai, postfix konverzió)

számítógépes





felso sarok

egyéb tételek

jobb felso sarok
 
A programok felépítése, az utasítasok típusai
Könyvtarak
PLC-S VEZÉRLÉSEK MEGBÍZHATÓSÁGÁNAK NÖVELÉSE
VoIP technológia
Adatbazis létrehozasa - Access
Rekurzió (particiószam, Hanoi tornyai, postfix konverzió)
 
bal also sarok   jobb also sarok

Rekurzió (particiószám, Hanoi tornyai, postfix konverzió).

Program Particio;


Var

n : Word;

Function P(n : Word) : Longint;

Function P2(m,n : Word) : Longint;

Begin

If (m = 1) Or (n = 1) Then

P2 := 1

Else If m <= n Then

P2 := 1 + P2(m,m-1)

Else

P2 :=P2(m,n-1) + P2(m-n,n)

End;

Begin



P:=P2(n,n);

End;

Begin

Writeln(' Kerem az inputot; 0 a vege ! '); Readln(n);

While n <> 0 Do Begin

Writeln('F(',n:1,') = ',P(n));

Readln(n)

End

End.

Program HanoiTornyai;

Uses Crt;

Const

N = 10;

N2= 20;

Var

Torony : Array[1..3] Of 0..N;

K : Array[0..N] Of String[N2];

Tx : Array[1..3] Of Byte;

Talp : Byte;

C : Char;

Procedure Inicializalas;

Var

i,j : Integer;

Begin

Talp := 20; Tx[1] := 1; Tx[2] := 29; Tx[3] := 57;

K[0] := '';

For i := 1 To N2 Do K[0] := Concat(K[0], ' ');

For i := 1 To N Do

Begin

K[i] := K[i-1];

For j := 1 To i Do

Begin

K[i][N-j+1] := #219;

K[i][N+j] := #219;

End;

End;

Torony[1] := N; Torony[2] := 0; Torony[3] := 0;

Clrscr;

GotoXY(1,1);

WriteLn(' A <z> kivetelevel barmely billentyu leutesere ');

WriteLn(' egy korongot rak at. A <z> leutese utan nem var!');

For i := 1 To N Do

Begin

GotoXY(TX[1], Talp-i); Write(K[N-i+1]);

End;

C := ' ';

End (* Inicializalas *);


Procedure Atrak(i, Rol, Ra : Integer);

Begin

If C <> 'z' Then

C := ReadKey;

GotoXY(Tx[Rol], Talp-Torony[Rol]); Dec(Torony[Rol]);

Write(K[0]);

Inc(Torony[Ra]);

GotoXY(Tx[Ra], Talp-Torony[Ra]);

Write(K[i]);

End (* Atrak *);


Procedure Hanoi(M, Honnan, Hova : Integer);

Begin

If M = 1

Then

Atrak(1, Honnan, Hova)

Else Begin

Hanoi(M-1, Honnan, 6-(Honnan+Hova));

Atrak(M, Honnan, Hova);

Hanoi(M-1,6-(Honnan+Hova), Hova);

End

End (* Hanoi *);


Begin

Inicializalas;

Hanoi(10,1,2);

End.

Program Postfix;


Uses Crt;

Var

Formula, PostForm : String[255];

i : Integer; Jel, Van : Char; Jo : Boolean;


Procedure KovJel;

Begin

Repeat

i := Succ(i);

Until Formula[i] <> ' ';

Jel := Formula[i]

End;


Procedure Tag; Forward;

Procedure Tenyezo; Forward;


Procedure Kifejezes;

Var

M : Char;

Begin

Tag;

While Jo And (Jel In ['+','-']) Do Begin

M := Jel;

KovJel;

Tag;

PostForm := PostForm + M;

End

End (* Kifejezes *);


Procedure Tag;

Var

M : Char;

Begin

Tenyezo;

While Jo And (Jel In ['*','/']) Do Begin

M := Jel;

KovJel;

Tenyezo;

PostForm := PostForm + M;

End

End (* Tag *);


Procedure Tenyezo;

Begin

Case Jel Of

'a'..'z','A'..'Z':

Begin

PostForm := PostForm + Jel; KovJel;

End;

'(' : Begin

KovJel;

Kifejezes;

If Jo And (Jel = ')') Then

KovJel

Else

Jo := False

End;

Else Jo := False

End (* Case *)

End (* Tenyezo *);


Begin

Repeat

ClrScr;

Writeln(' Kerem az input formulat ! ');

Readln(Formula);

Formula := Formula + '.' ; Postform := '';

i := 0; KovJel; Jo := True;

Kifejezes;

If Not Jo Or (Jel <> '.') Then

WriteLn('Hibas a formula: ',Copy(Formula,1,i),'<- itt a hiba!')

Else

WriteLn('A postfix alak: ',Postform);

WriteLn;

WriteLn('Van meg input? (I/N) ');

Van := Readkey;

Until UpCase(Van)='N';

End.

2. A kupacrendezés.


Procedure KupacRend(Var T : Tomb);

Var

i : Word; E : Elemtip;


Procedure Sullyeszt(K,L : Word );


Var

Apa,Fiu : Word;

Begin

E := T[K]; Apa := K; Fiu := 2*Apa;

While (Fiu <= L) Do Begin

If (Fiu < L) And (T[Fiu].kulcs < T[Fiu+1].kulcs) Then

Fiu := Fiu+1;

If E.kulcs >= T[Fiu].kulcs Then

Break

Else Begin

T[Apa] := T[Fiu];

Apa := Fiu; Fiu := 2*Apa

End

End;

T[Apa] := E

End (* Sullyeszt *);


Begin (* KupacRend *)

For i := TMeret Div 2 Downto 1 Do

Sullyeszt(i,TMeret);

For i := TMeret Downto 2 Do Begin

E := T[i]; T[i] := T[1]; T[1] := E;

Sullyeszt(1,i-1)

End;

End (* KupacRend *);

3. A gyorsrendezés.


Procedure Gyors(Var T:Tomb; Kisebb:RendRelTip);

Function Feloszt(Bal,Jobb : Word): Word;

Var

Fe,E : Elemtip;

i,j : Word;

Begin

Fe := T[(Bal+Jobb) Div 2];

i := Bal-1; j := Jobb+1;

While True Do Begin

Repeat

Inc(i)

Until Not Kisebb(T[i],Fe);

Repeat

Dec(j)

Until Not Kisebb(Fe,T[j]);

If I < J Then Begin

E := T[i]; T[i] := T[j]; T[j] := E;

End Else Begin

Feloszt:= j;

Exit

End;

End;

End (* Feloszt *);


Procedure Rendez(Bal,Jobb : Integer);

Var

f : Word;

Begin

f:= Feloszt(Bal, Jobb);

If Bal<f Then

Rendez(Bal, f);

If f<Jobb Then

Rendez(f+1, Jobb)

End (* Rendez *);

Begin

Rendez(1, N)

End; (* Gyors *)

4. Lineáris idejü rendezési algoritmusok (számláló, radix, vödrös).


Procedure Szamlalorend(Var T,T1 : Tomb);

Var

i,j : Word;

S: Array[0..M] Of Word;

Begin

For i := 0 To M Do S[i]:= 0;

For i := 1 To N Do Inc(S[T[i].kulcs]);

For i := 1 To M Do S[i]:= S[i-1]+S[i];

(* S[i]=|| *)

For i := N DownTo 1 Do

Begin

j := T[i].kulcs;

T1[ S[j] ]:= T[i];

Dec(S[j]);

End

End (* Szamlalorend *);



Procedure RadixRend(Var L : Lanc);

Var

T : Array[Char] Of Record

Eleje,Vege:Lanc;

End;

C : Char; E : Lanc;

i, Maxhossz : Word;

Begin

Maxhossz := 0; E:=L;(* a maximalis szohossz meghatarozasa *)

While E <> Nil Do

Begin

If Length(E^.Elem.kulcs) > Maxhossz Then

Maxhossz := Length(E^.Elem.kulcs);

E:= E^.Csat

End;

For C := Chr(0) To Chr(255) Do (* ures reszlistak letrehozasa *)

Begin

New(T[C].Vege); T[C].Eleje:= T[C].Vege;

End;


For i := Maxhossz Downto 1 Do

Begin

While L <> Nil Do (* szavak szetosztasa a reszlistakra, *)

Begin (* az i-edik betu szereint *)

E:= L; L:= L^.Csat;

If i <= Length(E^.Elem.kulcs) Then

C := E^.Elem.kulcs[i]

Else

C := ' ';

T[C].Vege^.Csat:= E;

T[C].Vege:= E;

End;

L:= Nil;

For C := Chr(255) DownTo Chr(0) Do

Begin (*a reszlistak osszekapcsolasa*)

T[C].Vege^.Csat:= L; L:= T[C].Eleje^.Csat;

T[C].Vege:=T[C].Eleje;

End

End

End (* RadixRend *);



Procedure VodrosRend(Var T,T1:Tomb);

Const

M=N; (* a vodrok szama *)

Type

Lanc=^Cella;

Cella=Record

index: Word;

Csat: Lanc

End;

Var

E: Elemtip;

V:Array[0..M-1] Of Lanc;

i,j,k : Word; p,q,Uj: Lanc;

Begin

For i := 0 To M-1 Do V[i]:= Nil;

For i := 1 To N Do

Begin (* az elemek szetosztasa *)

j:= Trunc(T[i].kulcs*M);

New(Uj); Uj^.index:= i;

Uj^.csat:= V[j]; V[j]:= Uj;

End;

i:= 1;

For j := 0 To M-1 Do (* a vodrokben levo elemek osszefuzese es *)

Begin (*rendezese beszuro rendezessel*)

p:= V[j];

While p <> Nil Do

Begin

E:= T[p^.index];

k:= i-1;

While (k>0) And (T1[k].kulcs > E.kulcs) Do

Begin

T1[k+1]:= T1[k]; Dec(k);

End;

T1[k+1]:= E; q:= p;

p:= p^.Csat; Dispose(q);

Inc(i);

End;

End;

End; (* VodrosRend *)

5. Mediánok és rendezett minták; k-adik legkisebb elemet kiválasztó algoritmusok.


Function Kivalaszt(Var T : Tomb; K : Word) : Word;

Function Feloszt(Bal,Jobb : Word): Word;

Var

E : Elemtip; Fk : Kulcstip;

i,j : Word;

Begin

Fk := T[Bal].kulcs;

I := Bal-1; J := Jobb+1;

While True Do

Begin

Repeat Inc(i)

Until Fk <= T[I].kulcs ;

Repeat Dec(j)

Until T[j].kulcs <= Fk;

If I < J Then

Begin

E := T[I]; T[I] := T[J]; T[J] := E;

End

Else Begin Feloszt:= j; Exit End;

End;

End (* Feloszt *);


Begin

Bal:=1; Jobb:=N;

While Bal < Jobb Do

Begin

Kozep:= Feloszt(Bal,Jobb);

If k<= Kozep-Bal+1 Then

Jobb:= Kozep

Else Begin

K:= K-(Kozep-Bal+1); Bal:= Kozep+1

End

End;

Kivalaszt:= Bal

End (* Kivalaszt *);

6. Külsö rendezési algoritmusok; összefésülö rendezések

Program KM_Rend;


Const

MaxMem = 15*1024;

MaxP = 32;

Type

Elemtip=Single;

MemTip=Array[1..MaxMem] Of Elemtip;

Var

P:Longint;

F: Array[Boolean] Of File;

FNev : String;

Mem: ^MemTip;

M : Longint;

BM : longint;

Rh : Longint;

N : Longint;

inf,ouf:Boolean;


Function OptP(N,M:Longint):Word;

Const

a=1.0; b=1000.0;

Var

r,rm,rmin,rmax:Longint;

NpM,Km,K:Real;


Function Log(a,x:Real):Real;

Begin

Log:=Ln(x)/Ln(a)

End;

Function Gyok(r,x:Real):Real;

Begin

Gyok:=Exp(Ln(x)/r);

End;


Begin

Km:=1.0E10; NpM:=N/M;

rmin:=Round(Log(m-1,N/M)+0.5); rmax:=Round(Log(2,N/M)+0.5);

For r:=rmin To rmax Do Begin

K:=r*(a*M/b + Gyok(r,NpM)+1);

If K<Km Then Begin

rm:=r; Km:=K;

End;

End;

OptP:=Round(Gyok(rm,NpM)+0.5);

End;


Procedure Belsorendez(Tol,Ig: Longint);

Var E,Fe:Elemtip;


Function BelFeloszt( Bal,Jobb: Longint): Longint ;

Var E,Fe : Elemtip; Tovabb:Boolean;

Begin

Fe := Mem^[(Bal+Jobb) Div 2]; Tovabb:=Bal <= Jobb;

While Tovabb Do Begin

While Mem^[Bal] < Fe Do Inc(Bal);

While Mem^[Jobb] > Fe Do Dec(Jobb);


If Bal < Jobb Then Begin

E := Mem^[Bal]; Mem^[Bal] := Mem^[Jobb]; Mem^[Jobb] := E;

Inc(Bal); Dec(Jobb);

End Else

Tovabb:=False

End;

BelFeloszt:=Jobb;

End (* BelFeloszt *);


Procedure Beszurorend(Kezd,Veg: Longint);

Var mi,i,j,N,d:Longint;

Begin

N:=Veg-Kezd+1;

mi:= Kezd;

If N<=11 Then d:=N-1 Else d:=10;

(* Strazsa allitasa az Kezd cimre *)

For i:=Kezd+1 To Kezd+d Do Begin

If (Mem^[i]<Mem^[mi]) Then mi:=i;

End;

Move(Mem^[Kezd], E, Rh);

Move(Mem^[mi], Mem^[Kezd], Rh);

Move(E, Mem^[mi], Rh);


For i:=Kezd+1 To Veg Do Begin

j:=i-1;

Move(Mem^[i], E,Rh);

While (E< Mem^[j]) Do Begin

Move(Mem^[j],Mem^[j+1],Rh);

Dec(j);

End;

Move(E,Mem^[j+1], Rh);

End;

End (* BeszuroRend *);


Procedure BRendez(Kezd,Veg : Longint);

Var

Kozep : Longint;

Begin

While (Veg-Kezd)>10 Do

Begin

Move(Mem^[(Kezd+Veg) Div 2], Fe, Rh);

Kozep:=BelFeloszt(Kezd,Veg);

If Kozep-Kezd > Veg-Kozep Then Begin

BRendez(Kezd, Kozep);

Kezd:=Kozep+1;

End Else Begin

BRendez(Kozep+1,Veg);

Veg:=Kozep;

End;

End;

End (* BRendez *);

Begin

If (Ig-Tol)>10 Then BRendez(Tol,Ig);

Beszurorend(Tol,Ig);

End; (* BelsoRendez *)


Procedure Nyit;

Var i:Integer;

s1,s2:String;

Begin

Val(ParamStr(1), M, i);


Rh:=Sizeof(Elemtip);

inf:=True; ouf:=False;

Assign(F[inf],FNev);


Reset(F[inf],1);


If IOResult <> 0 Then Halt;

N:=FileSize(F[inf]) Div Rh;

P:=OPtP(N,M);

BM:=M Div (P+1);



M:=(P+1)*BM;

If N<M Then Begin

M:=N; BM:=M;

End;


GetMem(Mem,M*Rh);

Assign(F[ouf],'tmp.dat');

Rewrite(F[ouf],1);

End;


Procedure Zar;

Var i:Word;

xF:File;

Begin

Close(F[inf]);

Close(F[ouf]);


Erase(F[inf]);

If inf Then Begin

Assign(xF,'tmp.dat');

Rename(xF, FNev);

End;


FreeMem(Mem,M*Rh);

End;


Procedure Menet0;

Var

Rr,Reksz:Longint;

Begin

Rr:=N;

While Rr >0 Do Begin

If Rr<M Then Reksz:=Rr Else Reksz:=M;

Dec(Rr,Reksz);

BlockRead(F[inf], Mem^[1], Reksz*Rh);

BelsoRendez(1, Reksz);

BlockWrite(F[ouf], Mem^[1], Reksz*Rh);

End;

End;


Procedure MergeRuns(nf,Fpoz,Lr,tLr:Longint);

Var i:Longint;

orp,Reksz:Longint;

S :Array[1..MaxP] Of Word;

Rr,

Mp,

Fp,EndP: Array[1..MaxP] Of Longint;

Sm:Longint;


Procedure SorEpit(Sm:Longint);

Var E:Elemtip;

Apa,fiu,i:Longint; Tovabb:Boolean;

Begin

For i:=1 To Sm Do S[i]:=i;

For i:= Sm Div 2 Downto 1 Do Begin

E:=Mem^[Mp[S[i]]];

Apa:=i;fiu:=i Shl 1; Tovabb:=True;

While Tovabb And (fiu<=Sm) Do Begin

If (fiu<Sm) And (Mem^[Mp[S[fiu+1]]]<Mem^[Mp[S[fiu]]]) Then

Inc(fiu);

If (E<Mem^[Mp[S[fiu]]]) Then

Tovabb:=False

Else Begin

S[Apa]:=S[fiu];

Apa:=fiu; fiu:=fiu Shl 1;

End;

End;

S[Apa]:=i;

End (* For *);

End (*SorEpit *);


Procedure SorBol(orp:Longint);

Var

Apa,fiu,bal,jobb,mf:Longint; Tovabb:Boolean;

E:Elemtip;

Begin

mf:=S[1];

Mem^[orp]:=Mem^[Mp[mf]];

Inc(Mp[mf]);

If Mp[mf]=EndP[mf] Then Begin

If Rr[mf]>0 Then Begin

If Rr[mf]>BM Then Reksz:=BM Else Reksz:=Rr[mf];

Mp[mf]:=(mf-1)*BM+1;

Seek(F[inf],Fp[mf]);

BlockRead(F[inf], Mem^[Mp[mf]], Reksz*Rh);

Dec(Rr[mf],Reksz);

Inc(Fp[mf],Reksz*Rh);

EndP[mf]:=Mp[mf]+Reksz;

End Else Begin

mf:=S[Sm]; S[1]:=mf;

Dec(Sm);

End;

End;


If Sm=0 Then Exit;


E:=Mem^[Mp[mf]];

Apa:=1;fiu:=2; Tovabb:=True;

While Tovabb And (fiu<=Sm) Do Begin

If (fiu<Sm) And (Mem^[Mp[S[fiu+1]]]<Mem^[Mp[S[fiu]]]) Then

Inc(fiu);

If (E<=Mem^[Mp[S[fiu]]]) Then

Tovabb:=False

Else Begin

S[Apa]:=S[fiu];

Apa:=fiu; fiu:=fiu Shl 1;

End;

End;

S[Apa]:=mf;

End (* SorBol *);


Begin

For i:=1 To nf-1 Do Begin

Mp[i]:=1+(i-1)*BM;

Fp[i]:=(Fpoz+(i-1)*Lr)*Rh;

Seek(F[inf],Fp[i]);

BlockRead(F[inf], Mem^[Mp[i]], BM*Rh);

EndP[i]:=Mp[i]+BM;

Rr[i]:=Lr-BM;

Inc(Fp[i],BM*Rh);

End;

If tLr>BM Then Reksz:=BM Else Reksz:=tLr;

Mp[nf]:=1+(nf-1)*BM;

Fp[nf]:=(Fpoz+(nf-1)*Lr)*Rh;

Seek(F[inf],Fp[nf]);

BlockRead(F[inf], Mem^[Mp[nf]], Reksz*Rh);

EndP[nf]:=Mp[nf]+Reksz;

Rr[nf]:=tLr-Reksz;

Inc(Fp[nf],Reksz*Rh);


Sm:=nf; SorEpit(Sm);

orp:=M-Bm;

While Sm<>0 Do Begin

Inc(orp);

Sorbol(orp);

If orp=M Then Begin

BlockWrite(F[ouf], Mem^[M-BM+1], BM*Rh);

orp:=M-BM;

End;

End;

BlockWrite(F[ouf], Mem^[M-BM+1], (BM-(M-orp))*Rh);

End;


Procedure FesuloMenet;

Var Lr,Nr,tLr,Fpoz:Longint;

i,lf:Word;

Begin

Lr:=M;

Repeat

inf:=ouf; ouf:=Not ouf;

Seek(F[inf],0); Seek(F[ouf],0);

Fpoz:=0;

Nr:=(N+P*Lr-1) Div (P*Lr);

lf:=(N Mod (P*Lr)+Lr-1) Div Lr;

If lf=0 Then lf:=P;

tLr:=N Mod Lr;

If tLr=0 Then tLr:=Lr;

For i:=1 To Nr-1 Do Begin

MergeRuns(P,Fpoz,Lr,Lr);

Inc(Fpoz,P*Lr);

End;

MergeRuns(lf,Fpoz,Lr,tLr);

Lr:=Lr*P;

Until Lr>=N;

End ;


Procedure Rendez;

Begin (* Rendez *)

Nyit;

If N<=M Then Begin

BlockRead(F[inf], Mem^[1], N*Rh);

BelsoRendez(1, N);

Seek(F[inf],0);

BlockWrite(F[inf], Mem^[1], N*Rh);

inf:=ouf; ouf:=Not inf;

End Else Begin

Menet0;

FesuloMenet;

End;

Zar;

End (* Rendez *);


Begin

FNev:= 't.dat';

Rendez;

End.

7. Külsö rendezési algoritmusok; partícionáló rendezések.

Program KP_Rend;


Const

maxP= 7;

MaxMem = 14*1024;

Type

Elemtip=Single;

MemTip =Array[0..MaxMem] Of Elemtip;

LinkP =^Cell;

Cell =Record Fn:Word; d,l:Longint; link:LinkP End;

Var

F: Array[0..MaxP+1] Of File;

FNev : String;

E:Array[1..MaxP*(MaxP+1) div 2] Of Single;


Mem: ^MemTip;


M : Longint;

M2 : Longint;

Rh : Longint;

N : Longint;

P : Longint;

Nr :

Array[0..maxP+1] Of Longint;


Top:LinkP;

Ip :Longint;

Mbent:Longint;


Function Pvalaszt(N:Longint):Word;


Const

ab=0.002;

Inf=10E10;

Var

P,PP,Op,Pm,Pn,k:Word;

L,Lpk:Longint;

Tp,Tmin,ab2:Single;

V:Array[1..512] of Longint;

Vp:Word;


Function Pmax(N:Longint):Word;

(* Pmax(N)=Min *)

Var bal,jobb,k:Word;

mn:Single;

Begin

mn:=M/N;

bal:=1; jobb:=MaxP;

While bal<jobb Do Begin

k:=(bal+jobb) div 2;

If E[k*(k-1)Shr 1+1]>mn Then

bal:=k+1

Else

jobb:=k

End;

Pmax:=jobb;

End;


Begin

Pn:=Pmax(N);

If Pn<=3 Then

Pvalaszt:=Pn

Else Begin

Tmin:=Inf;

ab2:=2.0*ab;

For P:=2 To Pn Do Begin

Vp:=1; Tp:=0.0;

V[1]:=N;

While Vp>0 DO Begin

L:=V[Vp]; Dec(Vp);

If L<=M Then

Tp:=Tp+ab2*L+2.0

Else Begin

Pm:=Pmax(L);

If (Pm<=3)And(P>Pm) Or (Pm<P) Then

Tp:=Tp+2*ab2*L+(Pm+1)*Round(L/M+0.5)+2*Pm

Else Begin

Tp:=Tp+ab2*L+(P+1)*Round(L/M+0.5);

PP:=P*(P-1) Shr 1;

For k:=1 To P Do Begin

Lpk:=Trunc(L*E[PP+k]);

Inc(Vp);

V[Vp]:=Lpk;

End

End;

End

End;

If Tp<Tmin Then Begin

Tmin:=Tp;

Op:=P;

End

End;

Pvalaszt:=OP;

End;

End;


Procedure Nyit;

Var i:Integer; Si:String;

EF:File of Single;

Begin

Assign(EF,'E.dat'); Reset(EF);

For i:=1 To MaxP*(MaxP+1) div 2 Do Begin

Read(EF,E[i]);

End;

Close(EF);


Val(ParamStr(1), M, i);


Rh:=Sizeof(Elemtip);


Assign(F[0],Fnev); Reset(F[0],1);

N:=FileSize(F[0]) Div Rh;


If Odd(M) Then Inc(M);

M2:=M Div 2;

GetMem(Mem,(M+1)*Rh);


For i:=1 To maxP+1 Do Begin

Str(i,Si);

Assign(F[i],'tmp.'+Si);

Rewrite(F[i],1);

Nr[i]:=0;

End;

Nr[0]:=0;

Top:=Nil;

End;


Procedure Zar;

Var i:Word;

Begin

Close(F[0]);

For i:=1 To maxP+1 Do Begin

Close(F[i]);

Erase(F[i]);

End;

FreeMem(Mem,M*Rh);

End;



Procedure Push(fn:Word; L,d:Longint);

Var Ucell:LinkP;

Begin

Inc(Nr[fn],L);

New(Ucell);

Ucell^.d:=d; Ucell^.L:=L; Ucell^.fn:=fn;

Ucell^.link:=Top;

Top:=Ucell;

End;


Procedure Pop(Var fn:Word; Var L,d:Longint);

Var dc:LinkP;

Begin

fn:=Top^.fn; d:=Top^.d; L:=Top^.L;

Dec(Nr[fn],L);

dc:=Top; Top:=dc^.link;

Dispose(dc);

End;


Procedure MBeTolt(From:Word; L:Longint; Var Origo:Longint);


Var bereksz:Longint;

Begin

bereksz:=(L-Mbent);

If bereksz=0 Then Exit;

If FilePos(F[From])<>Nr[From]*Rh Then

Seek(F[From], Nr[From]*Rh);

If bereksz<Ip Then Begin

Origo:=Ip-bereksz;

BlockRead(F[From], Mem^[Origo], Bereksz*Rh);

End Else If M-Ip+1>=L Then Begin

Origo:=Ip;

BlockRead(F[From], Mem^[Ip+Mbent], Bereksz*Rh);

End Else Begin;

Origo:=1;

BlockRead(F[From], Mem^[1], (Ip-1)*Rh);

BlockRead(F[From], Mem^[Ip+Mbent], (L-(Ip+Mbent-1))*Rh);

End;

End;


Procedure KiTolt(Fpos,Mpos,L:Longint);

Begin

Seek(F[0], Fpos*Rh);

BlockWrite(F[0], Mem^[Mpos], L*Rh);

End;


Function Feloszt( Bal,Jobb: Longint): Longint ;

Var Fe,E : Elemtip;

Bal0,Kozep:Longint;

Begin

Bal0:=Bal;

If Bal<Jobb Then Begin

kozep:=(Bal+Jobb) Div 2;

If Mem^[Jobb]<Mem^[Bal] Then Begin

E := Mem^[Bal]; Mem^[Bal] := Mem^[Jobb]; Mem^[Jobb] := E;

End;

If Mem^[kozep]>Mem^[Jobb] Then Begin

E := Mem^[Jobb]; Mem^[Jobb] := Mem^[kozep]; Mem^[kozep] := E;

End;

If Mem^[Bal]<Mem^[Kozep] Then Begin

E := Mem^[Bal]; Mem^[Bal] := Mem^[kozep]; Mem^[kozep] := E;

End;


Fe:=Mem^[Bal];


While True Do Begin

Repeat Dec(Jobb) Until Mem^[Jobb] <= Fe;

Repeat Inc(Bal) Until Mem^[Bal] >= Fe;

If Bal < Jobb Then Begin

E := Mem^[Bal]; Mem^[Bal] := Mem^[Jobb]; Mem^[Jobb] := E;

End Else

Break;

End;

End;

Feloszt:=Jobb;

E := Mem^[Jobb]; Mem^[Jobb] := Mem^[Bal0]; Mem^[Bal0] := E;

End(*Feloszt*);


Procedure MFeloszt(Var fn:Word; Var L,d:Longint; P:Word);



Var

Rem,

Reksz:Longint;

Fe:Array[1..maxP] Of Elemtip;

Pr:Array[1..maxP] Of Longint;

FF:Array[0..maxP] Of Longint;

i,ufn,ud:Longint;

mki:Longint;


Procedure FeValaszt(M,K,r:Longint);



Var FZh,Zh,zfi:Longint;

i:Word;


Procedure ZValaszt(Bal,Jobb:Longint);

Var fi,bzi,jzi:Longint;

Begin

bzi:=Bal Div Zh; jzi:=Jobb Div Zh;

While (bzi+1<jzi) Or

((bzi<=jzi) And ((FF[bzi]=0) Or (FF[jzi]=0))) Do Begin


fi:=Feloszt(Bal,Jobb);


zfi:=fi Div Zh;

If (fi Mod Zh >=r) And (FF[zfi]<fi) Then

FF[zfi]:=fi;


If Bal<=fi-1 Then ZValaszt(Bal,fi-1);

Bal:=fi+1;

If Bal>Jobb Then exit;

bzi:=Bal Div Zh;

End ;

End;


Begin

Zh:=r+(M-r*K) Div (K-1);

For i:=0 To K-2 Do Begin

FF[i]:=0;

End; FF[K-1]:=M-1;


ZValaszt(0,M-1);

End;


Procedure MemFeloszt(Bal,Jobb:Longint;fi,fj:Word);


Var K,fk,B,J:Longint;

Fel,E:Elemtip;

Begin

fk:=(fi+fj) Shr 1;

B:=Bal; J:=Jobb;

Fel:=Fe[fk];

While True Do Begin

While Mem^[B] < Fel Do Inc(B);

While Mem^[J] > Fel Do Dec(J);


If B < J Then Begin

E := Mem^[B]; Mem^[B] := Mem^[J]; Mem^[J] := E;

Inc(B); Dec(J);

End Else

Break;

End;

K:=J;

FF[fk]:=K;


If (fi<fk) And (Bal<=K) Then

MemFeloszt(Bal,K, fi,fk-1);

If (fk<fj) And (K<Jobb) Then

MemFeloszt(K+1,Jobb, fk+1,fj);

End;


Begin

For i:=1 To P Do Begin

Pr[i]:=0;

If FilePos(F[i])<>Nr[i]*Rh Then

Seek(F[i], Nr[i]*Rh);

End;

If FilePos(F[P+1])<>Nr[P+1]*Rh Then

Seek(F[P+1], Nr[P+1]*Rh);


MBetolt(fn,M,mki);

Mem^[0]:=Mem^[M];

FeValaszt(M,P,Trunc((M/P)*0.3));


mki:=0;

For i:=0 To P-1 Do Begin

Fe[i+1]:=Mem^[FF[i]];

Reksz:=FF[i]-mki+1;

Inc(Pr[i+1], Reksz);

If i+1=fn Then

BlockWrite(F[P+1], Mem^[mki], Reksz*Rh)

Else

BlockWrite(F[i+1], Mem^[mki], Reksz*Rh);



mki:=FF[i]+1;

End;

Mem^[0]:=Fe[1]; Mem^[M+1]:=Fe[P-1];


Rem:=L-M;

If Rem >M Then Reksz:=M Else Reksz:=Rem;

BlockRead(F[fn], Mem^[1], Reksz*Rh);

Dec(Rem,Reksz);


While True Do Begin

For i:=0 To P-1 Do FF[i]:=0;

FF[P]:=Reksz; Mem^[Reksz+1]:=Fe[P-1];

MemFeloszt(1,Reksz, 1,P-1);


If Rem=0 Then Break;

mki:=1;

For i:=1 To P Do If FF[i-1]<FF[i] Then Begin

Reksz:=FF[i]-mki+1;

Inc(Pr[i], Reksz);

If i=fn Then

BlockWrite(F[P+1], Mem^[mki], Reksz*Rh)

Else

BlockWrite(F[i], Mem^[mki], Reksz*Rh);

mki:=FF[i]+1;

End;


If Rem >M Then Reksz:=M Else Reksz:=Rem;

BlockRead(F[fn], Mem^[1], Reksz*Rh);

Dec(Rem,Reksz);

End;


MBent:=0; mki:=1;

For i:=1 To P Do

If (FF[i]>0) And (FF[i-1]<FF[i]) Then Begin

Reksz:=FF[i]-mki+1;

If (Reksz>MBent) Then Begin

MBent:=Reksz; ufn:=i;

End;

mki:=FF[i]+1;

End;


mki:=1;

For i:=1 To P Do Begin

If FF[i-1]<FF[i] Then

Reksz:=FF[i]-mki+1

Else

Reksz:=0;

Inc(Pr[i],Reksz);

If Pr[i]<>0 Then Begin

If i=ufn Then

ud:=d

Else Begin

If (i=fn) Then Begin

BlockWrite(F[P+1], Mem^[mki], Reksz*Rh);

Push(P+1, Pr[i], d);

End Else Begin

BlockWrite(F[i], Mem^[mki], Reksz*Rh);

Push(i, Pr[i], d);

End;

End;

Inc(d,Pr[i]);

Inc(mki,Reksz);

End;

End;


Ip:=FF[ufn-1]+1;

L:=Pr[ufn];

If ufn=fn Then fn:=P+1 Else fn:=ufn;

d:=ud;

End ;


Procedure BFeloszt(Var From:Word; Var L,d:Longint);



Var

Bal,Jobb:Longint;

To1,To2:Word;

Rem:Longint;

Bereksz:Longint;

K:Longint;

Bpr,Jpr:Longint;

Ki:Longint;

E,Fe:Elemtip;


Function FeValaszt2(Bal,Jobb,r:Longint):Longint;


Var fi,Zb,Zj:Longint;

E:Elemtip;

Begin

Zb:=Bal+r;

Zj:=Jobb-r;

While True Do Begin

fi:=Feloszt(Bal, Jobb);

If fi<Zb Then

Bal:=fi+1

Else If fi>Zj Then

Jobb:=fi-1

Else

Break;

End;


FeValaszt2:=fi;

End;


Begin(* BFeloszt *);

To1:=From+1; If To1>maxP Then To1:=1;

To2:=To1+1; If To2>maxP Then To2:=1;

Bpr:=0; Jpr:=0;

MBetolt(From,M,K);

Seek(F[To1] , Nr[To1]*Rh);

Seek(F[To2] , Nr[To2]*Rh);

Rem:=L-M;


K:=FeValaszt2(1,M,Trunc(M*0.3));


Fe:=Mem^[K];

Mem^[0]:=Fe; Mem^[M+1]:=Fe;


While Rem>0 Do Begin

If K<M2 Then Begin

If M-K>Rem Then Bereksz:=Rem Else Bereksz:=M-K;

Ip:=K+1; Ki:=To2;

End Else Begin

If K>Rem Then Bereksz:=Rem Else Bereksz:=K;

Ip:=K-Bereksz+1; Ki:=To1;

End;

Dec(Rem,Bereksz);

BlockWrite(F[Ki], Mem^[Ip], Bereksz*Rh);

BlockRead(F[From], Mem^[Ip], Bereksz*Rh);

If Ki=To1 Then Inc(Bpr,Bereksz) Else Inc(Jpr,Bereksz);


K:=Feloszt(Ip,Ip+Bereksz-1);

Bal:=Ip; Jobb:=Ip+Bereksz-1;

While True Do Begin

While Mem^[Bal] < Fe Do Inc(Bal);

While Mem^[Jobb] > Fe Do Dec(Jobb);


If Bal < Jobb Then Begin

E := Mem^[Bal]; Mem^[Bal] := Mem^[Jobb]; Mem^[Jobb] := E;

Inc(Bal); Dec(Jobb);

End Else

Break

End;

K:=Jobb;

End;


If Bpr=0 Then Begin

BelsoRendez(1,K);

KiTolt(d,1,K);

From:=To2; L:= L-K; d:=d+K;

Ip:=K+1; Mbent:=M-K;

End Else If Jpr=0 Then Begin

BelsoRendez(K+1,M);

KiTolt(d+Bpr+K,K+1,M-K);

From:=To1; L:= Bpr+K; d:=d;

Ip:=1; Mbent:=K;

End Else Begin

Inc(Bpr,K); Inc(Jpr,M-K);

If K<M2 Then Begin

BlockWrite(F[To1], Mem^[1], K*Rh);

Push(To1,Bpr,d);

Ip:=K+1; Mbent:=M-K;

From:=To2; L:=Jpr; d:=d+Bpr;

End Else Begin

BlockWrite(F[To2], Mem^[K+1], (M-K)*Rh);

Push(To2,Jpr,d+Bpr);

Ip:=1; Mbent:=K;

From:=To1; L:=Bpr; d:=d;

End;

End;

End;


Procedure Rendez(FNev : String);


Var

fn:Word;

L,

d,

Origo:Longint;


Begin (* Rendez *)

Nyit;

Ip:=1; Mbent:=0;

fn:=0; L:=N; d:=0;


Repeat

If L<=M Then Begin

MBeTolt(fn,L,Origo);

BelsoRendez(Origo,Origo+L-1);

KiTolt(d,Origo,L);

L:=0; Ip:=1; Mbent:=0;

End Else Begin

P:=Pvalaszt(L);

If P=2 Then Begin

BFeloszt(fn,L,d)

End Else Begin

MFeloszt(fn,L,d,P);

End;

End;


If (L=0) And (Top<>Nil) Then Begin

Pop(fn,L,d);

Ip:=1; MBent:=0;

End;

Until L=0;


Zar;

End (* Rendez *);


Begin

FNev:= 't.dat';

Rendez(FNev);

End.

8. Dinamikus programozás (pénzváltás, optimális bináris keresöfa).

Program Valto;

(* A penzvaltas problema

Input: p1,...pn, E pozitiv egeszek

Output: Eloallithato-e a E osszeg a p1,...,pn penzekkkel?

Azaz van-e olyan S resze 1..n, hogy Sum(pi: i elem S)=E


Const

MaxN=500;

Var

N:Word;

E:Word;

P:Array[1..MaxN] of Word;

Van:Boolean;


Procedure Beolv;


Var

Bef:Text;

i:Word;

Begin

Assign(Bef,'VALTO.BE'); Reset(Bef);

ReadLn(Bef,E);

ReadLn(Bef,N);

For i:=1 To N Do Begin

Read(Bef,P[i]);

End;

Close(Bef);

End;


Procedure KiIr;


Var

Kif:Text;

i,k:Word;

Begin

Assign(KiF,'VALTO.KI'); Rewrite(KiF);

If Van Then WriteLn(Kif,'Van megolds')

Else WriteLn(Kif,'Nincs megolds');

Close(KiF);

End;


Function V(X,i:Word):Boolean;



Begin

V:=(X=P[i]) Or

(i>1) And V(X,i-1) Or

(i>1) And (X>P[i]) And V(X-P[i],i-1) ;

End;


Function Vm(E:Word):Boolean;


Const

MaxE=100;

Var

VT:Array[0..MaxE,1..MaxN] Of 0..2;

i,j,x:Word;


Function V(X,i:Word):Boolean;


Var Jo:Boolean;

Begin

If VT[x,i]<2 Then

V:=VT[x,i]=1

Else Begin

Jo:=(X=P[i]) Or (i>1) And

((X>P[i]) And V(X-P[i],i-1) Or V(X,i-1));

VT[x,i]:=Ord(Jo);

V:=Jo;

End;

End;


Begin

For i:=1 To N Do

For x:=1 To E Do VT[x,i]:=2;

V(E,N);

Vm:=VT[E,N]=1;

End;


Function VT(E:Word):Boolean;


Const

MaxE=100;

Var

VTm:Array[0..MaxE,1..MaxN] Of Boolean;

i,x:Word;

Begin

For i:=1 To N Do

For x:=1 To E Do VTm[x,i]:=False;

If P[1]<=E Then VTm[P[1],1]:=True;


For i:=2 To N Do

For x:=1 To E Do

VTm[x,i]:=VTm[x,i-1] Or (x>=P[i]) And VTm[x-P[i],i-1];

Vt:=VTm[E,N];

End;


Function V1T(E:Word):Boolean;


Const

MaxE=60000;

Var

VT:Array[0..MaxE] Of Boolean;

i,x:Word;

Begin

For x:=1 To E Do VT[x]:=False;

VT[0]:=True;

If P[1]<=E Then VT[P[1]]:=True;


For i:=2 To N Do

For x:=E DownTo 1 Do

VT[x]:=VT[x] Or (x>=P[i]) And VT[x-P[i]];

V1T:=VT[E];

End;


Begin

Beolv;

Van:=V(E,N);

WriteLn(Van);

KiIr;

End.

Unit BinKerFa ;


Interface

Type

Kulcstip = 0..1;(*a redezési mezö tipusa*)

Adattip = 0..1; (* az adatmezö típusa *)

Elemtip = Record

kulcs: Kulcstip;

adat : Adattip

End;

BinFa = ^BinFaPont;

BinFaPont = Record

adat : Elemtip;

bal, jobb : BinFa

End;


Function Keres(F : BinFa;

K : Kulcstip) : BinFa;

Procedure Bovit0(Var F : BinFa; (* a bövítendö fa *)

X : Elemtip); (* a bövítendö elem *)

Procedure Bovit(Var F : BinFa; (* a bövítendö fa *)

X : Elemtip; (* a bövítendö elem *)

Var Tobb : Boolean ); (* lehet többszörös elem ? *)

Procedure Torol(Var F : BinFa;

K : Kulcstip; (* a törlendö pont kulcsa *)

Var Volt : Boolean); (* volt ilyen pont ? *)

Implementation

Function Keres(F : BinFa; K : Kulcstip) : BinFa;

Begin

While (F <> Nil) And (K<>F^.adat.kulcs) Do

If K < F^.adat.kulcs Then

F := F^.bal

Else

F := F^.jobb;

Keres:= F;

End (* Keres *) ;


Procedure Bovit0(Var F : BinFa;

X : Elemtip);


Begin

If F = Nil Then Begin

New(F);

F^.adat:= X;

F^.bal:= Nil; F^.jobb:= Nil;

End Else Begin

If X.kulcs < F^.adat.kulcs Then

Bovit0(F^.bal, X)

Else

Bovit0(F^.jobb, X)

End;

End (* Bovit0 *) ;


Procedure Bovit(Var F : BinFa;

X : Elemtip;

Var Tobb : Boolean );

Var

P, Apa, Ujp : BinFa;

Nincs : Boolean;

Begin

New(Ujp); Nincs := True;

With Ujp^ Do Begin

adat := X ;

bal := Nil; jobb := Nil

End;

If F = Nil Then

F := Ujp

Else Begin

P := F;

While (P <> Nil) Do Begin

Apa := P;

If X.kulcs < P^.adat.kulcs Then

P := P^.bal

Else

If X.kulcs > P^.adat.kulcs Then

P := P^.jobb

Else Begin

Nincs:= False;

If Not Tobb Then Begin

Tobb:= True; Dispose(Ujp); Exit

End Else

p:= p^.jobb

End

End;

If X.kulcs < Apa^.adat.kulcs Then

Apa^.bal := Ujp

Else

Apa^.jobb := Ujp

End;

Tobb := Not Nincs

End (* Bovit *) ;


Procedure Torol(Var F : BinFa;

K : Kulcstip;

Var Volt : Boolean);

Var

P, Apa, T : BinFa;

Tovabb : Boolean;

Begin

P := F; Apa := P; Tovabb := True;

(* a K kulcsu pont keresese *)

While (P <> Nil) And Tovabb Do

If K < P^.adat.kulcs Then Begin

Apa := P; P := P^.bal

End Else If K > P^.adat.kulcs Then Begin

Apa := P; P := P^.jobb

End Else

Tovabb := False;


Volt := Not Tovabb;

If Volt Then Begin

(* P^.adat.kulcs=K, Apa a P pont apja, ha P=F akkor P=Apa *)

T := P; (* a törlendö pont T *)

If P^.bal = Nil Then

If P = Apa^.bal Then

Apa^.bal := P^.jobb

Else If P = Apa^.jobb Then

Apa^.jobb := P^.jobb

Else F := P^.jobb

Else If P^.jobb = Nil Then

If P = Apa^.bal Then

Apa^.bal := P^.bal

Else

If P = Apa^.jobb Then

Apa^.jobb := P^.bal

Else

F := P^.bal

Else Begin

T := P^.jobb; Apa := T;

While T^.bal <> Nil Do Begin

Apa := T; T := T^.bal

End;

(* P helyebe T kerül *)

P^.adat := T^.adat;

If T = Apa Then

P^.jobb := T^.jobb

Else

Apa^.bal := T^.jobb;

End;

Dispose(T)

End

End (* Torol *) ;


End (* BinKerFa *) .

9. A mohó stratégia (egységnyi végr. munkák ütemezése, Huffman kód).


Procedure EgyUtemez( K : Haszon;

H : Hatarido;

Var B : Beosztas;

Var P : Real );

Var

i,j : Integer;

Begin

P := 0.0;

For i := 1 To N Do B[i] := 0;

For i := 1 To N Do Begin

If H[i] > N Then

j := N

Else

j := H[i];

While (j > 0) And (B[j] = 0) Do

Dec(j);

If j > 0 Then Begin



B[j] := i; P := P + K[i]

End

End;

End (* EgyUtemez *);

Program Huffman_Kod;

Uses MPsor;

Const n=???;

Type

Gyakori= Array[0..2*n-1] Of Longint;

Fa= Array[1..2*n-1] Of Integer;


Function Kis(Var X,Y: Elemtip): Boolean;


Begin

Kis:= P[X] <= P[Y]

End;


Procedure Huffman(Var P: Gyakori; Var T: Fa);

Var S: MPsor.Tipus; i,pont,x,y: Word;


Begin

Letesit(S, Kis);

For i:= 1 To n Do Sorba(S,i);

T[2*n-1]:=0;

pont:= n;

For i:= 1 To n-1 Do Begin

Sorbol(S,x); Sorbol(S,y);

Inc(pont);

T[x]:= -pont; T[y]:= pont;

P[pont]:= P[x]+ P[y];

Sorba(S,pont);

End;

End;


Procedure KiIr(Var T:Fa; i:Word);

Begin

If T[i]<>0 Then Begin

KiIr(T,Abs(T[i]));

If T[i]<0 Then Write(0:1)

Else Write(1:1);

End;

End;


Var

T:FA; P:Gyakori; i:Word;

Begin

For i:= 1 To n Do Read(P[i]);

Huffman(P,T);

For i:= 1 To n Do Begin KiIr(T,i); writeln; End

End.

10. Megoldás szisztematikus keresése visszalépéssel.



Procedure UresX(Var X:MTer);Forward;


Function EFiu(Var X: MTer): Boolean; Forward;


Function Testver(Var X: MTer): Boolean; Forward;


Function Apa(Var X: MTer):Boolean; Forward;



Function Megoldas (Var X: MTer): Boolean; Forward;

Function LehetMego(Var X: MTer): Boolean; Forward;




Procedure RKeres(X:MTer);



Begin

If Megoldas(X) Then Begin

X0:=X;

Van:=True; Exit

End;

If Not EFiu(X) Then Exit;

Repeat

If Not LehetMego(X) Then

Continue;

RKeres(X);

If Van Then

Until Not Testver(X)

End;


Procedure Keres(X:MTer);



Var Elsore: Boolean;

Begin (* Keres *)

If Not LehetMego(X) Then Exit;

Elsore:=True;

While True Do

If Elsore Then Begin

If Megoldas(X) Then Begin

X0:=X;

Break

End;

Elsore:=(EFiu(X) And LehetMego(X));

End Else If Testver(X) Then

Elsore:=LehetMego(X)

Else If Not Apa(X) Then

Break;

End (* Keres *);

11. Megoldás szisztematikus keresése elágazás-korlátozással.

Program Elagazas_Korlatozas;


Type

MTer = Record End;(* a megoldaster tipusa *)

PriSor= Record End;(* a maximumos prioritasi sor tipusa *)

Const

Inf=1.0E10;


Procedure Uresit(Var S:PriSor);

Begin End;

Procedure SorBa(Var S:PriSor; X:MTer);

Begin End;

Procedure SorBol(Var S:PriSor; Var X:MTer);

Begin End;

Procedure Megszuntet(Var S:PriSor);

Begin End;

Function Ures(S:PriSor):Boolean;

Begin End;



Procedure UresX(Var X:MTer);


Begin End;

Function EFiu(Var X: MTer): Boolean;


Begin End;

Function Testver(Var X: MTer): Boolean;


Begin End;


Function Megoldas(Var X: MTer): Boolean;


Begin End;

Function LehetMego(Var X: MTer): Boolean;



Begin End;


Function C(Const X: MTer): Real;


Begin End;

Function AK(Var X: MTer): Real;


Begin End;

Function FK(Var X: MTer): Real;


Begin End;


Procedure BBKeres1(X:MTer; Var X0:MTer; Var C0:Real);




Var

S:PriSor;

G_F_K:Real;

Begin (* BBKeres1 *)

UresX(X0);

G_F_K:=Inf;

If Not LehetMego(X) Then Exit;

Uresit(S);

SorBa(S,X);

While Not Ures(S) Do Begin

SorBol(S,X);

If G_F_K<=AK(X) Then Exit;

If EFiu(X) Then

Repeat

If Not LehetMego(X) Then

Continue;

If AK(X)>=G_F_K Then Continue;

If Megoldas(X) And

(C(X)<G_F_K) Then Begin

G_F_K:=C(X);

X0:=X;

End;

SorBa(S,X);

Until Not Testver(X);

End;

C0:=G_F_K;

End (* BBKeres1 *);


Procedure BBKeres2(X:MTer; Var X0:MTer; Var C0:Real);




Var

S:PriSor;

G_F_K:Real;

Begin (* BBKeres2 *)

C0:=Inf;

If Not LehetMego(X) Then Exit;

G_F_K:=FK(X);

Uresit(S);

SorBa(S,X);

While Not Ures(S) Do Begin

SorBol(S,X);

If AK(X)>G_F_K Then Begin

Megszuntet(S);

Exit;

End;

If EFiu(X) Then

Repeat

If Not LehetMego(X) Then

Continue;

If G_F_K<AK(X) Then Continue;

If Megoldas(X) And (C(X)<=G_F_K)

Then Begin

X0:=X;

G_F_K:=C(X)

End Else If FK(X)<G_F_K Then

G_F_K:=FK(X);

SorBa(S,X);

Until Not Testver(X);

End;

C0:=G_F_K;

End (* BBKeres2 *);


Begin End.

12. Absztrakt adattipusok: Verem, Sor, Lista, Prioritási sor, Sorozat, Halmaz, Függvény.

Unit Verem;

Interface


Elemtip = ???;(*a generikus parameter*)

Tipus = Pointer; (*a Veremp adattipus fo tipusa*)

Verem = Verem0.Tipus;


Procedure Letesit(Var V : Tipus);

Procedure Megszuntet(Var V : Tipus);

Procedure Uresit(Var V : Tipus);

Procedure VeremBe(Var V : Tipus; X : Elemtip);

Procedure VeremBol(Var V : Tipus; Var X : Elemtip);

Function Urese(V : Tipus) : Boolean;

Procedure Teteje(V : Tipus; Var X : Elemtip);

Procedure Torol(Var V : Tipus);

Implementation

End (* Verem0 *).

Unit Sor ;

Interface

Type

Elemtip = ???; (*generikus parameter*)

Tipus = Pointer; (* a Sor adattipus tipusa *)


Procedure Letesit(Var S : Tipus);

Procedure Megszuntet(Var S : Tipus);

Procedure Uresit(Var S : Tipus);

Function Elemszam(S : Tipus) : Word;

Procedure SorBa(Var S : Tipus; X : Elemtip);

Procedure SorBol(Var S : Tipus; Var X : Elemtip);

Procedure Elso( S : Tipus; Var X : Elemtip);

Procedure Torol(Var S : Tipus);

Unit Lista;

Interface

Type

Elemtip = ???; (* a lista elemtipusa *)

Tipus = Pointer; (* a lista adattipus tipusa *)


Procedure Letesit(Var L : Tipus);

Procedure Uresit(Var L : Tipus);

Function Urese(L : Tipus) : Boolean;

Function Elejen(L : Tipus) : Boolean;

Function Vegen(L : Tipus) : Boolean;

Procedure Elejere(Var L : Tipus);

Procedure Vegere(Var L : Tipus);

Procedure Tovabb(Var L : Tipus);

Procedure Kiolvas( L : Tipus; Var X : Elemtip);

Procedure Modosit(Var L : Tipus; Y : Elemtip);

Procedure Bovit(Var L : Tipus; Y : Elemtip);

Procedure Torol(Var L : Tipus);

Procedure Kapcsol(Var L1,L2 : Tipus);

Unit PriSor ;


Interface

Type

Elemtip = ???;

RendRelTip = Function (Var X,Y: Elemtip): Boolean;

Tipus = Pointer;(*az adattipus fö tipusa*)


Procedure Letesit(Var S : Tipus; M: RendRelTip);

Procedure Megszuntet(Var S : Tipus);

Procedure Uresit(Var S : Tipus);

Function Elemszam(S : Tipus) : Word;

Procedure SorBa(Var S : Tipus; Y : Elemtip);

Procedure SorBol(Var S : Tipus; Var X : Elemtip);

Procedure Elso(S : Tipus; Var X :Elemtip);

Procedure Torol(Var S: Tipus);

Unit Sorozat ;

Interface

Type

Elemtip = ???;(* a sorozat elemeinek tipusa *)

Tipus = Pointer;(*az adattipus fö tipusa*)


Procedure Letesit(Var S : Tipus);

Procedure Megszuntet(Var S : Tipus);

Procedure Uresit(Var S : Tipus);

Function Elemszam(S : Tipus) : Word;

Procedure Bovit(Var S : Tipus; i : Word; Y : Elemtip);

Procedure Torol(Var S : Tipus; i : Word);

Procedure Kiolvas( S : Tipus; i : Word; Var X : Elemtip);

Procedure Modosit(Var S : Tipus; i : Word; Y : Elemtip);

Unit Halmaz ;

Interface

Type

Elemtip = ???

Tipus = Pointer; (* az adattipus fö tipusa *)

Iterator = Pointer; (* az itertor tipusa *)


Procedure Letesit(Var H : Tipus);

Procedure Megszuntet(Var H : Tipus);

Procedure Uresit(Var H : Tipus);

Function Eleme(H : Tipus; E : Elemtip) : Boolean;

Function Elemszam(H : Tipus) : Word;


Procedure Bovit(Var H : Tipus; Y : Elemtip);

Procedure Torol(Var H : Tipus; E : Elemtip);

Procedure IterKezd( H : Tipus; Var I : Iterator);

Procedure IterAd(Var I : Iterator; Var X : Elemtip);

Function IterVege(I : Iterator) : Boolean;

(* Halmaz *)

Unit Fuggveny;

Interface

Type

Kulcstip= ???; (* a Függvény elemeinek kulcstípusa *)

Adattip = ???; (* a Függvény elemeinek adattípusa *)

Elemtip = Record

kulcs : Kulcstip;

adat : Adattip

End;

Tipus = Pointer; (* az adattípus reprezentáló típusa *)

Iterator = Pointer; (* az iterátor típusa *)


Procedure Letesit(Var F : Tipus);

Procedure Megszuntet(Var F : Tipus);

Procedure Uresit(Var F : Tipus);

Function Eleme(F : Tipus; K : Kulcstip) : Boolean;

Function Elemszam(F : Tipus) : Word;

Procedure Kiolvas( F : Tipus; K : Kulcstip; Var A : Adattip);

Procedure Modosit(Var F : Tipus; K : Kulcstip; A : Adattip);

Procedure Bovit(Var F : Tipus; Y : Elemtip);

Procedure Torol(Var F : Tipus; K : Kulcstip);

Procedure IterKezd( F : Tipus; Var I : Iterator);

Procedure IterAd(Var I : Iterator; Var K : Kulcstip);

Function IterVege(I : Iterator) : Boolean;

(* Fuggveny *)

13. Fák, fák ábrázolása, fabejáró algoritmusok.

Type

Elemtip=???;

Fa=^FaPont;

FaPont=Record

Adat:Elemtip;

Efiu,Testver:Fa;

Apa:FA

End;

MuvelTip=Procedure(Var X:Elemtip);

Procedure Bejar(P:Fa; M:MuvelTip);

Begin

M(P^.Adat);

P:=P^.Efiu;

While P<>Nil Do Begin

Bejar(P,M);

P:=P^.Testver;

End;

End;

Procedure Bejar2(P:Fa; M:MuvelTip);

Begin

M(P^.Adat);

If P^.Efiu<> Nil Then

Bejar2(P^.Efiu,M);

If P^.Testver<> Nil Then

Bejar2(P^.Testver,M);

End;

Procedure VBejar1(P:Fa; M:MuvelTip);


Var V:Verem; Elsore:Boolean;

Begin

Letesit(V); Elsore:=True;

VeremBe(V,Nil);

While P<>Nil Do Begin

If Elsore Then Begin

M(P^.Adat);

If P^.Efiu<> Nil Then Begin

VeremBe(V,P);

P:=P^.Efiu;

End Else

Elsore:=False

End Else Begin

P:=P^.Testver;

If P<>Nil Then

Elsore:=True

Else

VeremBol(V,P);

End;

End;

End;

Procedure ABejar(P:Fa; M:MuvelTip);


Begin

While P<>Nil Do Begin

M(P^.Adat);

While (P^.Efiu<>Nil) Do Begin

P:=P^.Efiu;

M(P^.Adat);

End;

While (P<>Nil) And (P^.Testver=Nil) Do

P:=P^.Apa;

If P<>Nil Then

P:=P^.Testver;

End;

End;

Procedure VBejar(P:Fa; M:MuvelTip);


Var V:Verem;

Begin

Letesit(V); VeremBe(V,Nil);

While P<>Nil Do Begin

M(P^.Adat);

While (P^.Efiu<>Nil) Do Begin

If P^.Testver<>Nil Then

VeremBe(V,P^.Testver);

P:=P^.Efiu;

M(P^.Adat);

End;

If P^.Testver<>Nil Then

P:=P^.Testver

Else

VeremBol(V,P);

End;

End;

Procedure SzBejar(P:Fa; M:MuvelTip);


Var S:Sor;

Begin

Letesit(S);

SorBa(S,P);

While Elemsazam(S)>0 Do Begin

SorBol(S,P);

M(P^.Adat);

P:=P^.Efiu;

While (P<>Nil) Do Begin

SorBa(S,P);

P:=P^.Testver;

End;

End;

End;


















































Találat: 1975







Felhasználási feltételek