题目:合并果子

状态: 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.

看看刚开始学的时候我写的这个……34行……

题目:合并果子

状态: 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.

我写得太长了，没办法

且我的速度比你快多了

好牛逼

82行又如何？我的比你还快、还长，以空间换时间

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.