Đề thi HSG Tin TPHCM 2009 khối THPT

ặc, đề gì mà khó quá vậy anh Phong, em đọc zô chẳng hỉu chi hết trơn, công nhận mình còn íu tin thiệt

anh Khang nói chi zạ, đề anh Phong lớp 12, hiểu chi nổi

trong mấy bài này thì bài ngoặc dễ nhất

hiz....đề khó quá đi

Program Dau_ngoac;
Const fi='ngoac.inp';
fo='ngoac.out';
Var f,sf:text;
s:string;
d,d1:integer;

Procedure Main;
Var i:byte;kt:boolean;
Begin
Assign(f,fi); Reset(f);
Assign(sf,fo);Rewrite(sf);
While not eof do
Begin
Readln(f,s);
d1:=0;d:=0;kt:=true;
for i:= length(s) downto 1 do
begin
if (S[i]=')') then inc(d) ;
if (S[i]='(') then dec(d) ;
if (S[i]='[') then dec(d1) ;
if (S[i]=']') then inc(d1) ;
if (d<0) or (d1<0) then
begin
kt:=false;
break;
end;
end;

if (kt=true) and (d=0) and (d1=0) then writeln(sf,'True')
else writeln(sf,'False');
End;
Close(f);Close(sf);

End.
Bài ngoặc

Bài 1 này dễ mà em ^^ Đúng hơn gọi là bài về stack
Thử 2,3 xem

Mấy bài này ko khó lắm:
Sâm:
program sam;
const
fi='sam.inp';
fo='sam.out';
max=100;
var
gr:array[1..max,1..max] of word;
test:array[1..max,1..max] of boolean;
a,b,n,i:byte;
res:word;
f:text;

procedure load;
var
i,j:byte;
f:text;
begin
assign(f,fi);
reset(f);
readln(f,n,a,b);
for i:=1 to n do
begin
for j:=1 to n do
read(f,gr[i,j]);
readln(f);
end;
close(f);
end;

procedure process(i:byte;dem:word);
var
j:byte;
begin
for j:=1 to n do
if (gr[i,j]<>0) and (test[i,j]) then
begin
test[i,j]:=false;
test[j,i]:=false;
if j<>b then
process(j,dem+gr[i,j])
else
if (res=0) or (res<dem) then
res:=dem+gr[i,j];
end;
end;

begin
load;
assign(f,fo);
rewrite(f);
fillchar(test,sizeof(test),true);
res:=0;
for i:=1 to n do
if gr[a,i]<>0 then
begin
test[a,i]:=false;
test[i,a]:=false;
process(i,gr[a,i]);
fillchar(test,sizeof(test),true);
end;
write(f,res);
close(f);
end.

Bài chuối nè, đổi lại thành banana cho nó hay:
program banana;
const
fi='banana.inp';
fo='banana.out';
max=1000;
var
a:array[1..max] of word;
m,k:word;

procedure load;
var
n,i,j,maxr,maxc:word;
f:text;
a1:array[1..max,1..max] of boolean;

function sum(i,j:word):word;
begin
a1[i,j]:=false;
sum:=1;
if (i>1) and (a1[i-1,j]) then
sum:=sum+sum(i-1,j);
if a1[i+1,j] then
sum:=sum+sum(i+1,j);
if (j>1) and (a1[i,j-1]) then
sum:=sum+sum(i,j-1);
if a1[i,j+1] then
sum:=sum+sum(i,j+1);
end;

begin
assign(f,fi);
reset(f);
readln(f,n,k);
fillchar(a1,sizeof(a1),false);
maxr:=0;
maxc:=0;
for m:=1 to n do
begin
readln(f,i,j);
if (maxr=0) or (maxr<i) then
maxr:=i;
if (maxc=0) or (maxc<j) then
maxc:=j;
a1[i,j]:=true;
end;
close(f);
m:=0;
for i:=1 to maxr do
for j:=1 to maxc do
if a1[i,j] then
begin
m:=m+1;
a[m]:=sum(i,j);
end;
end;

procedure process;
var
i,sum,j,max:word;
f:text;
begin
sum:=0;
for i:=1 to k do
begin
max:=0;
for j:=1 to m do
if (a[j]<>0) and ((max=0) or (a[max]<a[j])) then
max:=j;
sum:=sum+a[max];
a[max]:=0;
end;
assign(f,fo);
rewrite(f);
write(f,sum);
close(f);
end;

begin
load;
process;
end.

Cho một chuỗi nhị phân vô hạn được tạo theo quy tắt
s[0]='0';
s[n+1]=s[n]+s[n'] với n=0,1,2,3,4,...
Với s[n'] là chuổi đảo ngược của chuỗi s[n] được tạo ra bằng cách thay các phần tử '0' của s[n] bằng '1', thay các phần tử '1' của s[n] bằng '0' và gán lần lượt vào chuỗi s[n']
Ví dụ
s[n]='1001' thì s[n']='0110';
Ta được một chuỗi nhị phân vô hạn có dạng
'01101001100101101001011001101001...'
Yêu cầu : Nhập từ file binary.inp một số n<=2000000000, cho biết phần tử thứ n của chuỗi đó là 0 hay 1
Ví dụ
binary.inp: 5
binary.out: 1
Giới hạn: Chương trình có thể viết bằng TPascal nên không dùng được mảng char quá lớn hoặc widestring, ansistring