2000 - NHỮNG CHIẾC GẬY(DÀNH CHO HỌC SINH THPT)PROGRAM BAI48;VAR...

Bài 48/2000 - Những chiếc gậy

(Dành cho học sinh THPT)

Program bai48;

Var x:array[0..10000] of word;

d,a:array[1..1000] of byte;

n,p,s,gtmax:word;

fi,fo:text;

ok:boolean;

Procedure Q_sort(l,k:word);

Var h,i,j,t:word;

Begin

h:=a[(l+k)div 2];i:=l;j:=k;

Repeat

While a[i]>h do inc(i);

While a[j]<h do dec(j);

If i<=j then

Begin

t:=a[i];a[i]:=a[j];a[j]:=t;

inc(i);dec(j);

End;

Until i>j;

if i<k then Q_sort(i,k);

if j>l then Q_sort(l,j);

End;

Procedure phan(var ok:boolean);

Var i,p1,j:word;

Fillchar(x,sizeof(x),0);x[0]:=1;

For i:=1 to n do

If (d[i]=0) then

For j:=p downto a[i] do

If (x[j]=0) and(x[j-a[i]]<>0) then

Begin

x[j]:=i;

if j=p then

Begin

j:=a[i];

i:=n;

End;

End;

ok:=(x[p]<>0);

if ok then

p1:=p;

Repeat

d[x[p1]]:=1;

p1:=p1-a[x[p1]];

Until p1=0;

Procedure chat(Var ok:boolean);

Var i:word;

Fillchar(d,sizeof(d),0);

Repeat

phan(ok);

Until not ok;

ok:=true;

for i:= n downto 1 do

if d[i]=0 then

Begin

ok:=false;

break;

End;

Procedure Tinh;

For p:=gtmax to s div 2 do

chat(ok);

if ok then

writeln(fo,p);

break;

If not ok then

Writeln(fo,s);

Procedure Start;

assign(fi,'input.txt');reset(fi);

assign(fo,'output.txt');rewrite(fo);

While not seekeof(fi) do

Readln(fi,n);

if n<>0 then

gtmax:=0;s:=0;

for i:=1 to n do

Begin

Read(fi,a[i]);

s:=s+a[i];

if a[i]> gtmax then

gtmax:=a[i];

End;

Q_sort(1,n);

Tinh;

Close(fi);Close(fo);

Start;

End.

9

5 2 1 5 2 1 5 2 1

4

1 2 3 4

0

(Lời giải của bạn Tăng Hải Anh - Hải Dương - TP. Hải Phòng)