Download đáp án olympic tin học 30 04 2004

§¸P ¸N OLIMPIC 30-04-2004
Bµi 1: Xaucon
{$R+,Q+}
Const
Fi
=
'Xaucon.inp';
Fo
=
'Xaucon.out';
Var F
:
Text;
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
Read(f,ch);
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


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;
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;


End;
Procedure 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]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


Assign(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 maxBegin
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]);
End;
Close(f);
End;

V:=tr[v];


Begin

Init;

Qhd;

End.