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
  

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: 2082


Felhasználási feltételek