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)
Bạn đang xem bài 48/ - 100 DE TIN HSG CO DAP AN