|  | ||||||||
|  | ||||||||
| | ||||||||
| | ||||||||
 |
kategória |  |
||||||||
|
|
||||||||||
 |
 |
|
|
|
|
|
||
|
|
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: 2107
