SỞ GIÁO DỤC VÀ ĐÀO TẠO TỈNH YÊN BÁI HƯỚNG DẪN CHẤM CHÍNH THỨC... CAU3.PAS Khai báo và đọc được dữ liệu từ tệp.[r]
Trang 1SỞ GIÁO DỤC VÀ ĐÀO TẠO
TỈNH YÊN BÁI
HƯỚNG DẪN CHẤM CHÍNH THỨC
(Hướng dẫn chấm có 05 trang,
gồm 04 câu)
KỲ THI LẬP ĐỘI TUYỂN DỰ THI CHỌN HỌC SINH GIỎI
QUỐC GIA THPT NĂM 2013 – VÒNG II
Môn thi: Tin học
Thời gian: 180 phút (không kể thời gian giao đề)
Ngày thi: 12/11/2012
program bt1;
const fi='CAU1.inp';
fo='CAU1.out';
var a:array[1 10,1 10] of integer;
n,m:integer;
procedure doc;
var f:text;
i,j:integer;
begin
assign(f,fi); reset(f);
readln(f,m,n);
for i:=1 to m do
for j:=1 to n do read(f,a[i,j]);
close(f);
end;
procedure xl;
var i,j,k,tg:integer;
begin
for i:=1 to m do
begin
for j:=1 to n-1 do
for k:=j+1 to n do
if a[i,j]>a[i,k] then
begin
tg:=a[i,j];a[i,j]:=a[i,k];a[i,k]:=tg;
end;
end;
for j:=1 to n do
begin
for i:=1 to m-1 do
for k:=i+1 to m do
if a[i,j]>a[k,j] then
begin
tg:=a[i,j];a[i,j]:=a[k,j];a[k,j]:=tg;
end;
end;
end;
procedure ghi;
var f:text;
i,j:integer;
begin
assign(f,fo);rewrite(f);
for i:=1 to m do
begin
for j:=1 to n do write(f,a[i,j],' '); writeln(f);
end;
1,0
1,0
1,5
1,5
1,0
Trang 2close(f);
end;
begin
doc;
xl;
ghi;
end
program bt1;
const fi='CAU2.inp';
fo='CAU2.out';
var a,x,xs:array[1 10] of integer;
t1,t2,t3,t4,kl,cl,n,sx:integer;
procedure doc;
var f:text;
i,j:integer;
begin
assign(f,fi);reset(f);
readln(f,n);
for i:=1 to n do read(f,a[i]);
close(f);
end;
function max(a,b:integer):integer;
var m:integer;
begin
m:=a;
if m<b then m:=b;
max:=m;
end;
function min(a,b:integer):integer;
var m:integer;
begin
m:=a;
if m>b then m:=b;
min:=m;
end;
procedure try(i:integer);
var j:integer;
begin
for j:=1 to 4 do
begin
x[i]:=j;
if j=1 then t1:=t1+a[i];
if j=2 then t2:=t2+a[i];
if j=3 then t3:=t3+a[i];
if j=4 then t4:=t4+a[i];
if i=n then
begin
cl:=max(t1,max(t2,max(t3,t4)))-min(t1,min(t2,min(t3,t4)));
if cl<kl then
begin
kl:=cl;
xs:=x;
end;
end
else try(i+1);
if j=1 then t1:=t1-a[i];
1,0
1,0
1,0
1,0
1,0
Trang 3if j=2 then t2:=t2-a[i];
if j=3 then t3:=t3-a[i];
if j=4 then t4:=t4-a[i];
end;
end;
procedure ghi;
var f:text;
j:integer;
begin
assign(f,fo);rewrite(f);
writeln(f,kl);
for j:=1 to n do if xs[j]=1 then write(f,j,' ');writeln(f);
for j:=1 to n do if xs[j]=2 then write(f,j,' ');writeln(f);
for j:=1 to n do if xs[j]=3 then write(f,j,' ');writeln(f);
for j:=1 to n do if xs[j]=4 then write(f,j,' ');writeln(f);
close(f);
end;
begin
t1:=0;t2:=0;t3:=0;t4:=0;kl:=maxint;
doc;
try(1);
ghi;
end
1,0
Khai báo và đọc được dữ liệu từ tệp
Procedure TaoBang;
Var xk, yk, k: Byte;
FMax, XMax, v : Word;
Begin
For v:= 1 To W Do
begin
X[1, v] := v div A[1];
F[1, v] := X[1, v] * C[1];
end;
For k:= 2 To n Do
For v:= 1 To W Do
begin
FMax := F[k-1, v] ;
XMax := 0;
yk := v div A[k];
For xk:= 1 To yk Do
If (v - xk * A[k] > 0) and
F[k-1, v - xk * A[k]] + xk * C[k] > FMax) Then
begin
FMax := F[k-1, v - xk * A[k]] + xk * C[k];
XMax:= xk;
end;
F[k, v] := FMax;
X[k, v] := XMax;
end;
End;
Giải thuật tra bảng:
Fx[n, W] là giá trị lớn nhất của ba lô
Bắt đầu từ X[n, W] là số món hàng loại k được chọn
Tính v = W – X[n, W]* A[n]
Tìm đến ô [n – 1, v ] ta tìm được X[n – 1, v] Cứ tiếp tục ta tìm được X[1, v]
1,0
2,0
1,0
Trang 4PROGRAM Chanel;
uses crt;
const
inp = 'CAU4.inp';
out = 'CAU4.out';
max = 1001;
type
arr = array[0 max] of Integer;
var
fi,fo : text;
n,dem : Integer;
A,S,T,Lab,P : Arr;
{***************************}
procedure readinp;
var
i : Integer;
begin
assign(fi,inp); reset(fi);
readln(fi,n);
for i := 1 to n do
begin
readln(fi,S[i],T[i]);
P[i] := i;
end;
close(fi);
end;
{***************************}
procedure swap(var i,j : Integer);
var
tmp : Integer;
begin
tmp := i; i := j; j := tmp;
end;
{***************************}
procedure Qsort(A : arr);
procedure sort(l,r : Integer);
var
i,j,key : Integer;
begin
if l >= r then exit;
key := A[P[l+random(r-l+1)]];
i := l; j := r;
repeat
while A[P[i]] < key do inc(i);
while A[P[j]] > key do dec(j);
if i <= j then
begin
swap(P[i],P[j]);
inc(i); dec(j);
end;
until i > j;
sort(l,j); sort(i,r);
end;
begin
sort(1,n);
end;
{***************************}
1,0
1,0
1,0
Trang 5procedure solve;
var
i,j,key,f : Integer;
begin
dem := 0;
Qsort(S);
fillchar(Lab,sizeof(Lab),0);
for i := 1 to n do
if lab[P[i]] = 0 then
begin
inc(dem); Lab[P[i]] := dem;
f := T[P[i]];
for j := i +1 to n do
if (S[P[j]] >= f)and (Lab[P[j]] = 0) then
begin
f := T[P[j]];
Lab[P[j]] := dem;
end;
end;
end;
{***************************}
procedure writeout;
var
i,j,f : Integer;
begin
assign(fo,out);
rewrite(fo);
writeln(fo,dem);
fillchar(Lab,sizeof(Lab),0);
for i := 1 to n do
if lab[P[i]] = 0 then
begin
inc(dem);
f := T[P[i]]; Lab[P[i]] := dem;
write(fo,P[i],' ');
for j := i+1 to n do
if (S[P[j]] >= f) and (Lab[P[j]] = 0)then
begin
write(fo,P[j],' ');
f := T[P[j]];
Lab[P[j]] := dem;
end;
writeln(fo);
end;
close(fo);
end;
{***************************}
BEGIN
clrscr;
readinp;
solve;
writeout;
END
1,0