状态: Accepted
测评机: Xeond[6]
得分: 100分 [我要评价一下题目~]
提交日期: 2012-8-6 12:07:00
有效耗时: 1781毫秒
测试结果1: 通过本测试点|有效耗时234ms
测试结果2: 通过本测试点|有效耗时157ms
测试结果3: 通过本测试点|有效耗时172ms
测试结果4: 通过本测试点|有效耗时171ms
测试结果5: 通过本测试点|有效耗时172ms
测试结果6: 通过本测试点|有效耗时188ms
测试结果7: 通过本测试点|有效耗时172ms
测试结果8: 通过本测试点|有效耗时172ms
测试结果9: 通过本测试点|有效耗时171ms
测试结果10: 通过本测试点|有效耗时172ms
提交代码: view sourceprint?
program rq25fruit;
const MaxN=30000;
var
a:array[1..MaxN]of longint;
n:integer;
Min:longint;
procedure DataIn;
var i:integer;
begin
{assign(input,'fruit.in');reset(input);}readln(n);
for i:=1 to n do read(a[i]);
{close(input);}
end;
procedure DataWork;
var x,y,z:longint;
procedure SiftUp(k:integer);
var
done:boolean;
p:integer;
temp:longint;
begin
done:=false;
if k=1 then Exit;
repeat
p:=k div 2;
if a[k]<a[p] then
begin
temp:=a[k];a[k]:=a[p];a[p]:=temp;end
else done:=true;
k:=p;
until (k=1)or done;
end;
procedure SiftDown(k:integer);
var
done:boolean;
p:integer;
temp:longint;
begin
done:=false;
if 2*k>n then Exit;
repeat
p:=2*k;
if (p+1<=n)and(a[p]>a[p+1]) then inc(p);
if a[k]>a[p] then
begin
temp:=a[k];a[k]:=a[p];a[p]:=temp;end
else done:=true;
k:=p;
until (2*k>n)or done;
end;
procedure Insert(x:longint);
begin
inc(n);a[n]:=x;SiftUp(n);
end;
function DeleteMin:longint;
begin
DeleteMin:=a[1];a[1]:=a[n];dec(n);
SiftDown(1);
end;
procedure MakeHeap;
var
i,p:integer;
begin
p:=n div 2;
for i:=p downto 1 do SiftDown(i);
end;
begin
MakeHeap;Min:=0;
repeat
x:=DeleteMin;y:=DeleteMin;
z:=x+y;inc(min,z);
Insert(z);
until n=1;
end;
procedure DataOut;
begin
{assign(output,'fruit.out');rewrite(output);}
writeln(min);{close(output)}
end;
begin
DataIn;
DataWork;
DataOut;
end.
题目:合并果子
状态: Accepted
测评机: Xeost[5]
得分: 100分 [我要评价一下题目~]
提交日期: 2012-1-20 22:05:00
有效耗时: 4875毫秒
测试结果1: 通过本测试点|有效耗时172ms
测试结果2: 通过本测试点|有效耗时172ms
测试结果3: 通过本测试点|有效耗时172ms
测试结果4: 通过本测试点|有效耗时281ms
测试结果5: 通过本测试点|有效耗时313ms
测试结果6: 通过本测试点|有效耗时734ms
测试结果7: 通过本测试点|有效耗时797ms
测试结果8: 通过本测试点|有效耗时734ms
测试结果9: 通过本测试点|有效耗时781ms
测试结果10: 通过本测试点|有效耗时719ms
program guozi;
var
n:longint;
bo:longint;
a:array[1..10000] of longint;
i,j,k:longint;
begin
readln(n);
for i:=1 to n do read(a[i]);
readln;
for i:=1 to n-1 do
for j:=i+1 to n do
if a[j]<a[i] then
begin
k:=a[j];
a[j]:=a[i];
a[i]:=k;
end;
for i:=1 to n-1 do
begin
a[i+1]:=a[i+1]+a[i];
bo:=bo+a[i+1];
for j:=i+2 to n do
if a[j]<a[j-1] then
begin
k:=a[j];
a[j]:=a[j-1];
a[j-1]:=k;
end
else break;
end;
write(bo);
readln
end.
program rq25fruit;
const MaxN=30000;
var
a:array[1..MaxN]of longint;
n:integer;
Min:longint;
procedure DataIn;
var i:integer;
begin
{assign(input,'fruit.in');reset(input);}readln(n);
for i:=1 to n do read(a[i]);
{close(input);}
end;
procedure DataWork;
var x,y,z:longint;
procedure SiftUp(k:integer);
var
done:boolean;
p:integer;
temp:longint;
begin
done:=false;
if k=1 then Exit;
repeat
p:=k div 2;
if a[k]<a[p] then
begin
temp:=a[k];a[k]:=a[p];a[p]:=temp;end
else done:=true;
k:=p;
until (k=1)or done;
end;
procedure SiftDown(k:integer);
var
done:boolean;
p:integer;
temp:longint;
begin
done:=false;
if 2*k>n then Exit;
repeat
p:=2*k;
if (p+1<=n)and(a[p]>a[p+1]) then inc(p);
if a[k]>a[p] then
begin
temp:=a[k];
a[k]:=a[p];
a[p]:=temp;
end
else done:=true;
k:=p;
until (2*k>n)or done;
end;
procedure Insert(x:longint);
begin
inc(n);
a[n]:=x;
SiftUp(n);
end;
function DeleteMin:longint;
begin
DeleteMin:=a[1];a[1]:=a[n];dec(n);
SiftDown(1);
end;
procedure MakeHeap;
var
i,p:integer;
begin
p:=n div 2;
for i:=p downto 1 do SiftDown(i);
end;
begin
MakeHeap;Min:=0;
repeat
x:=DeleteMin;y:=DeleteMin;
z:=x+y;inc(min,z);
Insert(z);
until n=1;
end;
procedure DataOut;
begin
{assign(output,'fruit.out');rewrite(output);}
writeln(min);{close(output)}
end;
begin
DataIn;
DataWork;
DataOut;
end.