Begin Init; Qhd; End..
Trang 1§¸P ¸N OLIMPIC 30-04-2004
Bµi 1: Xaucon
{$R+,Q+}
Mang : Array[0 10000] Of Char;
N,m,k : Longint;
Procedure Init;
Var I,KQ : Longint;
Sla,slb,sl,d,c,l:integer;
Ch:Char;
Begin
Kq:=0;
Assign(f,fi);
Reset(f);
Readln(f,n,m,k);
Sla:=0;
Slb:=0;
Kq:=0;
D:=0;
C:=-1;
Sl:=0;
For i:=1 to n do
Begin
C:=(c+1) mod (m+1);
Mang[c]:=ch;
Inc(sl);
If ch='A' then Inc(sla);
If sl>m then
Begin
If mang[d]='A' then
Begin
Slb:=0 ;
Dec(sla);
End
Else
If slb>0 then Dec(slb);
D:=(d+1) mod (m+1);
Dec(sl);
End;
While sla>k do
Begin
Trang 2If Mang[d]='A' then Begin
Slb:=0;
Dec(sla);
End
Else
If slb=0 then Dec(slb); D:=(d+1) mod (m+1); Dec(sl);
End;
If (slb=0) and (sla=k) then Begin
L:=d;
While Mang[l]='B' do Begin
Inc(slb); L:=(l+1) mod (m+1); End;
End;
If sla=k then
Inc(kq,slb+1);
End;
Close(f);
assign(f,fo);
Rewrite(f);
Writeln(kq);
Close(f);
End;
Begin
Init;
End
Bµi 2: HOP.PAS
{$M 63840,0,655360}
Const Fi='HOP.inp';
Fo='HOP.out';
Type Mang=Array[1 3] Of Byte;
Var Vt:Array[0 5001] Of Integer; A:Array[0 5000] Of Mang;
N:Integer; F:Text;
Procedure Doi(Var A,b:Longint);
Var T:Longint;
Begin
T:=a; A:=b; B:=t;
Trang 3Procedure Doi1(Var A,b:Integer); Var T:Integer;
Begin
T:=a; A:=b; B:=t;
End;
Procedure Doi2(Var A,b:Byte); Var T:Byte;
Begin
T:=a; A:=b; B:=t;
End;
Procedure Sap(Var T:Mang);
Var I,j:Integer;
Begin
For i:=1 to 2 do
For j:=i+1 to 3 do
If T[i]<t[j] then Doi2(t[i],t[j]); End;
Procedure DoiM(Var a,b:Mang); Var T:mang;
Begin
T:=a; A:=b; B:=t;
End;
Procedure Init;
Var S:Array[0 5001] Of Longint; I,j:Integer;
procedure Sort(l, r: Integer);
var i, j, x: Longint;
begin
i := l; j := r; x := s[(l+r) DIV 2]; repeat
while s[i] < x do i := i + 1;
while x < S[j] do j := j - 1;
if i <= j then
begin
Doim(A[i],a[j]);
Doi(S[i],s[j]);
Doi1(vt[i],vt[j]);
i := i + 1; j := j - 1;
end;
until i > j;
if l < j then Sort(l, j);
if i < r then Sort(i, r);
end;
Begin
Trang 4Assign(f,fi); Reset(f);
Readln(f,n);
For i:=1 to n do
Begin
For j:=1 to 3 do Read(f,a[i,j]);
Sap(a[i]);
S[i]:=Longint(a[i,1])*Longint(a[i,2]);
Vt[i]:=i;
End;
Close(f);
Sort(1,n);
End;
Procedure QHD;
Var I,j,max,v,v1:Longint;
Sl,tr:Array[0 5001] Of Longint;
Begin
For i:=1 to n do Sl[i]:=A[i,3];
Fillchar(tr,sizeof(tr),0);
For i:=2 to n do
For j:=i-1 downto 1 do
If Sl[j]+Longint(A[i,3])>sl[i] then
If A[i,1]>=a[j,1] then
If A[i,2]>=a[j,2] then
Begin
Tr[i]:=j;
Sl[i]:=sl[j]+Longint(A[i,3]);
End;
Max:=A[1,3]; V:=1;
For i:=1 to n do If max<sl[i] then
Begin
Max:=sl[i]; V:=i;
End;
Assign(f,fo); Rewrite(f);
V1:=v; Max:=0;
While V1>0 do
Begin
Inc(max); V1:=tr[v1];
End;
Writeln(f,max);
For I:=1 to max do
Begin
Writeln(f,Vt[v],' ',A[v][2],' ',a[v][1],' ',a[v][3]); V:=tr[v]; End;
Close(f);
End;
Trang 5Begin Init; Qhd; End.