1. Trang chủ
  2. » Tất cả

123tailieu.com_dap-an-de-thi-hsg-tin-cua-tien-giang-nam-2009

5 8 0

Đang tải... (xem toàn văn)

THÔNG TIN TÀI LIỆU

Thông tin cơ bản

Định dạng
Số trang 5
Dung lượng 39,5 KB

Các công cụ chuyển đổi và chỉnh sửa cho tài liệu này

Nội dung

Câu 2: 7 điểm Factory - "Nhà máy" Nhà máy Intel cần sản xuất dây chuyền mainboard máy tính.. Có N công việc; Công việc i cần ai ngày công.. Mỗi công đoạn sản phẩm là kết hợp 2 công việc

Trang 1

SỞ GDĐT TIỀN GIANG

TRƯỜNG THPT CHUYÊN TIỀN GIANG

ĐÁP ÁN ĐỀ THI ĐỀ NGHỊ

KỲ THI CHỌN HỌC SINH GIỎI ĐBSCL

MÔN TIN HỌC NĂM HỌC 2008 – 2009

Câu 1: (6 điểm) Serpent - “Số rắn hai đầu”

Program Serpent;

Const

Inp='Serpent.inp';

Out='Serpent.out';

Type Number=Array[0 10000] of shortint;

Var

n100,n99,n:Number;

a,b:byte;

Last:longint;

Procedure Init;

Var fi:text;

Begin

assign(fi,inp); reset(fi);

readln(fi,a,b); close(fi);

last:=-1;

End;

Procedure Process;

Var

i,p:longint;

Begin

n99[0]:=b;

i:=0; p:=0; {p>0}

repeat

n[i]:=n100[i]-n99[i]-p;

p:=0;

if n[i]<0 then

begin

n[i]:=n[i]+10;

p:=1;

end;

n99[i+1]:=n[i];

n100[i+2]:=n[i];

if n[i]=a then

if n[i-1]=0 then

begin

last:=i-2;

break;

end;

inc(i);

if i>10000 then

break;

until false;

End;

Procedure Result;

Var

fo:text;

i:longint;

Begin

Trang 2

assign(fo,out); rewrite(fo);

for i:=last downto 0 do write(fo,n[i]);

close(fo);

End;

BEGIN

Init;

Process;

Result;

END

Câu 2: (7 điểm) Factory - "Nhà máy"

Nhà máy Intel cần sản xuất dây chuyền mainboard máy tính Có N công việc; Công việc i cần ai ngày công Mỗi công đoạn sản phẩm là kết hợp 2 công việc liên tiếp lại với nhau thành một công việc với chi phí bằng tổng ngày công 2 công việc đó Bạn hãy giúp nhà máy ghép N công việc đó lại thành từng công đoạn sao cho tổng chi phí công đoạn là nhỏ nhất.

{CHAY TRONG FREE PASCAL}

const

fi='Factory.inp';

fo='Factory.out';

maxn=101;

type

mang=array[1 maxn]of longint;

mang1=array[1 maxn]of integer;

var

a:mang1;

f,g:mang;

n:byte;

{ -}

procedure enter;

var i:byte;

begin

readln(n);

for i:=1 to n do read(a[i]);

end;

{ -}

procedure init;

begin

fillchar(f,n,0);

fillchar(g,n,0);

f[1]:=0;

f[2]:=a[1]+a[2];

g[1]:=a[1];

g[2]:=f[2];

end;

{ -}

function min2(a,b:longint;var k:byte):longint;

begin

if a<b then

begin

k:=1;

exit(a)

end else

begin

k:=2;

exit(b);

end;

end;

{ -}

procedure vunsoi;

var

Trang 3

i:byte;

k:byte;

begin

for i:=3 to n do

begin

f[i]:=min2(a[i]+g[i-1]+f[i-1],a[i]+a[i]+a[i-1]+a[i-1]+g[i-2]+f[i-2],k);

if k=1 then g[i]:=a[i]+g[i-1] else g[i]:=a[i]+a[i-1]+g[i-2]; end;

end;

{ -}

procedure writeresult;

var i,j:byte;

kq1,kq2:array[1 maxn]of longint;

begin

writeln(f[n]);

i:=n;

j:=0;

while i>2 do

begin

j:=j+1;

if f[i]=a[i]+g[i-1]+f[i-1] then

begin

kq1[j]:=a[i];

kq2[j]:=g[i-1];

i:=i-1;

end else

begin

kq1[j]:=g[i-2];

kq2[j]:=a[i]+a[i-1];

j:=j+1;

kq1[j]:=a[i];

kq2[j]:=a[i-1];

i:=i-2;

end;

end;

if i=2 then

begin

j:=j+1;

kq1[j]:=a[1];

kq2[j]:=a[2];

end;

for i:=j downto 1 do writeln(kq1[i],' ',kq2[i]);

end;

{============================================================}

BEGIN

assign(input,fi);reset(input);

assign(output,fo);rewrite(output);

enter;

init;

vunsoi;

writeresult;

close(input);close(output);

END

Trang 4

Câu 3: (7 điểm) Max-polygon - "Đa giác lồi cực đại"

Cau 3:

Const maxn = 100;

fi = 'Polygon.inp';

fo = 'Polygon.out';

Var x,y : array[1 maxn+1] of Longint;

l,pre : array[1 maxn+1,1 maxn+1] of integer; n: integer;

function mien(x1,y1,x2,y2,x3,y3: longint): integer; var p: integer;

begin

p:= x1*(y2-y3) + x2*(y3-y1) + x3*(y1-y2);

if p < 0 then mien:=-1;

if p > 0 then mien:=1;

if p = 0 then mien:=0;

end;

procedure read_input;

var f: text;

i: integer;

begin

assign(f,fi);

reset(f);

readln(f,n);

for i:=2 to n+1 do readln(f,x[i],y[i]);

x[1]:=0;

y[1]:=0;

n:=n+1;

close(f);

end;

procedure solve;

var i,j,k,jj: integer;

tmp: integer;

begin

for i:=2 to n-1 do

for j:=i+1 to n do

if y[i]*x[j] > y[j]*x[i] then

begin

tmp:=x[i]; x[i]:=x[j]; x[j]:=tmp;

tmp:=y[i]; y[i]:=y[j]; y[j]:=tmp;

end;

for i:=2 to n do l[1,i]:=1;

for i:=2 to n do

for jj:=i+1 to n+1 do

begin

if jj=n+1 then j:=1

else j:=jj;

l[i,j]:=-1;

for k:=1 to i-1 do

if mien(x[k],y[k],x[i],y[i],x[j],y[j]) = 1 then

if (l[i,j] = -1) or (l[k,i]+1 > l[i,j]) then begin

l[i,j]:=l[k,i]+1;

pre[i,j]:=k;

end;

end;

end;

procedure write_output;

var fout: text;

li,i,j,sd,k,temp,sol:integer;

begin

assign(fout,fo);

rewrite(fout);

sol:=2;

for i:=2 to n do

if l[i,1] > sol then

begin

Trang 5

sol:=l[i,1];

li:=i;

end;

writeln(fout,sol);

i:=li;

j:=1;

for sd:=1 to sol do

begin

writeln(fout,x[i],' ',y[i]); k:=pre[i,j];

j:=i;

i:=k;

end;

close(fout);

end;

BEGIN

read_input;

solve;

write_output;

END

Ngày đăng: 03/03/2017, 00:12

🧩 Sản phẩm bạn có thể quan tâm

w