Së GD&§T
Qu¶ng b×nh
kú thi CHäN häc sinh giái cÊp tØnh líp 12 THPT
n¨m häc 2012 - 2013
M«n thi: tin häc - Vßng iI
híng dÉn chÊm
I. Phương pháp:
- Giám khảo tạo bộ dữ liệu vào, tính toán kết quả. Thực hiện chương trình của
học sinh và so sánh kết quả.
- Giám khảo có thể sử dụng chương trình gợi ý dưới đây để tính toán kết quả
của dữ liệu vào.
- Chương trình học sinh đúng một bộ test, giám khảo cho 0,5 điểm. Như vậy,
nếu một câu có 3 điểm thì giám khảo phải tạo 6 bộ test.
- Với mỗi câu, giám khảo phải tạo được ít nhất một bộ test có không gian dữ
liệu lớn.
- Riêng Câu 3, chỉ số các hộp được chọn của HS có thể khác với đáp án. Nếu
kết quả của học sinh khác đáp án nhưng vẫn đúng thì giám khảo vẫn cho điểm tối
đa.
II. Chương trình gợi ý:
Câu 1: (3,0 điểm) Tính diện tích tam giác
{$r+}
const fi='dt.inp';
fo='dt.out';
type mm=array [1..4] of integer;
var a,b:mm;
f:text;
s:real;
procedure nhap;
var i:integer;
begin
assign(f,fi);
reset(f);
for i:=1 to 3 do readln(f,a[i],b[i]);
close(f);
end;
procedure xuly;
var i:integer;
T1,T2:LONGINT;
begin
a[4]:=a[1];
b[4]:=b[1];
s:=0;
for i:=1 to 3 do
begin
t1:=b[i+1]+b[i];
t2:=a[i+1]-a[i];
s:=s+(t1*t2)/2;
end;
end;
procedure xuat;
begin
assign(f,fo);
rewrite(f);
write(f,abs(s):0:1);
close(f);
end;
begin
nhap;
xuly;
xuat;
end.
Câu 2: (3,5 điểm) Đặt vé vào sân NouCamp
Const
fi='noucamp.in1';
fg='noucamp.out';
1
maxn=51000;
type mmc=array[1..maxn] of byte;
var a:mmc;
ti,n,m:longint;
procedure xl;
var
f:text;
i,x:longint;
by,bi:word;
begin
fillchar(a,sizeof(a),0);
assign(f,fi);reset(f);
readln(f,n,m);
for i:=1 to m do
begin
read(f,x);
by:=(x div 8)+1;
bi:= x mod 8;
if bi=0 then
begin
bi:=8;
by:=by-1;
end;
a[by]:=a[by] or (1 shl (bi-1));
end;
close(f);
end;
procedure xuat;
var f:text; i,j:longint;
begin
assign(f,fg);rewrite(f);
{writeln(f,n-m);}
for i:= 1 to n div 8 do
for j:=1 to 8 do
if ((a[i] shr (j-1)) and 1)=0 then write(f,(i-1)*8+j,' ');
close(f);
end;
begin
xl; xuat;
end.
Câu 3: (3,5 điểm) Xếp hộp lồng nhau
{$R+,Q+}
{$M 63840,0,655360}
Const Fi='xephop.in1';
Fo='xephop.out';
Type Mang=Array[0..5000] of integer;
Var A,b,vt:Mang;
F:Text;
M,n:integer;
Function Max(a,b:Integer):integer;
Begin
Max:=a;
If b>a then Max:=b;
End;
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 Init;
Var S:Array[0..5000] Of Longint;
I,j:Integer;
procedure Sort(l, r: Integer);
var
i, j, x, y: Longint;
begin
i := l; j := r; x := s[(l+r) DIV 2];
repeat
2
while s[i] < x do i := i + 1;
while x < s[j] do j := j - 1;
if 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 vt[i]:=i;
For i:=1 to n do
Begin
Readln(f,a[i],b[i]);
If A[i]a[i]) And (b[j]>b[i]);
End;
Procedure Qhd;
Var I,j,maxx,v:Integer;
Tr,sl:Array[0..5000] Of Integer;
Begin
For i:=1 to n do sl[i]:=1;
For i:=2 to n do
For j:=i-1 downto 1 do
If sl[j]+1>sl[i] then
if Bao(j,i) then
Begin
Tr[i]:=j;
Sl[i]:=sl[j]+1;
End;
Maxx:=1;
V:=1;
For i:=1 to n do
If Maxx ... (bi -1)) ; end; close(f); end; procedure xuat; var f:text; i,j:longint; begin assign(f,fg);rewrite(f); {writeln(f,n-m);} for i:= to n div for j:=1 to if ((a[i] shr (j -1)) and 1)= 0 then write(f,(i -1)* 8+j,'