535 条题解
-
0
wilsonlym LV 8 @ 2009-07-18 17:22:24
program fruit2;
var
n,i,min,j,k,x:longint;
a:array[0..10005]of longint;
procedure heap(i,n:longint);
var
j,x:longint;
begin
x:=a[i];
j:=i*2;
while ja[j] then
begin
a[i]:=a[j];
i:=j;
j:=2*j;
end
else break;
end;
a[i]:=x;
end;
begin
readln(n);
for i:=1 to n do
read(a[i]);
for i:=n div 2 downto 1 do
heap(i,n);
min:=0;
k:=n;
for i:=1 to n-1 do
begin
x:=0;
x:=x+a[1];
a[1]:=a[k];
dec(k);
heap(1,k);
x:=x+a[1];
min:=min+x;
a[1]:=x;
heap(1,k);
end;
writeln(min);
end.堆排才是王道！（快排会超时，堆排只用插入找位子就可以了。）
-
0
编译通过...
├ 测试数据 01：答案正确... 228ms
├ 测试数据 02：答案正确... 0ms
├ 测试数据 03：答案正确... 0ms
├ 测试数据 04：答案正确... 0ms
├ 测试数据 05：答案正确... 9ms
├ 测试数据 06：答案正确... 0ms
├ 测试数据 07：答案正确... 447ms
├ 测试数据 08：答案正确... 509ms
├ 测试数据 09：答案正确... 431ms
├ 测试数据 10：答案正确... 384ms
---|---|---|---|---|---|---|---|-
Accepted 有效得分：100 有效耗时：2008ms我靠,PUPPY机是强大,看时间↑
这是我同学的号,为什么我当时没找到这么好的测评机,日 -
0
var
n,i,j,sum,k,h,min:longint;
flag:integer;
a,b:array[1..10002]of longint;
procedure qsort(l,r:integer);
var i,j,temp,mid:integer;
begin
i:=l;j:=r;
mid:=a[(r+l)div 2];
repeat
while a[i]mid do j:=j-1;
if ij;if il then qsort(l,j);
end;begin
readln(n);for i:=1 to 10000 do
begin
a[i]:=12345678;
b[i]:=12345678;
end;
for j:=1 to n do
read(a[j]);
qsort(1,n);
i:=1;j:=1;sum:=0;h:=0;
for k:=1 to n-1 do
begin
min:=maxlongint;
if (a[i]+a -
0
a554268278 LV 4 @ 2009-07-14 16:25:48
program jj;
var a:array [1..10000] of integer;
f:array [1..10000] of longint;
i,j,k,l,h,n:integer;
o:longint;
begin
read(n);
readln;
for l:=1 to n do
read(a[l]);
h:=n;
for k:=1 to n-1 do
begin
for i:=1 to h do
for j:=i+1 to h do
if a[i]>a[j] then begin
l:=a[i];
a[i]:=a[j];
a[j]:=l;
end;
f[k]:=a[1]+a[2];
a[2]:=f[k];
a[1]:=0;
for i:=1 to h do
a[i]:=a;
a[h]:=0;
h:=h-1;
end;
for i:=1 to n-1 do
o:=o+f[i];
write(o)
end. -
0
program jj;
var a:array [1..10000] of integer;
f:array [1..10000] of longint;
i,j,k,l,h,n:integer;
o:longint;
begin
read(n);
readln;
for l:=1 to n do
read(a[l]);
h:=n;
for k:=1 to n-1 do
begin
for i:=1 to h do
for j:=i+1 to h do
if a[i]>a[j] then begin
l:=a[i];
a[i]:=a[j];
a[j]:=l;
end;
f[k]:=a[1]+a[2];
a[2]:=f[k];
a[1]:=0;
for i:=1 to h do
a[i]:=a;
a[h]:=0;
h:=h-1;
end;
for i:=1 to n-1 do
o:=o+f[i];
write(o)
end. -
0
桶排加队列，完美O(N)。
et.bug编译通过...
├ 测试数据 01：答案正确... 0ms
├ 测试数据 02：答案正确... 0ms
├ 测试数据 03：答案正确... 0ms
├ 测试数据 04：答案正确... 0ms
├ 测试数据 05：答案正确... 0ms
├ 测试数据 06：答案正确... 0ms
├ 测试数据 07：答案正确... 0ms
├ 测试数据 08：答案正确... 0ms
├ 测试数据 09：答案正确... 0ms
├ 测试数据 10：答案正确... 0ms
---|---|---|---|---|---|---|---|-
Accepted 有效得分：100 有效耗时：0ms
var
n,i,j,l1,l2,r1,r2,x,min,t:longint;
a,b:array[0..10001] of longint;
f:array[0..20001] of longint;
begin
readln(n);
for i:=1 to n do
begin
read(x);
f[x]:=f[x]+1;
end;
x:=0;
for i:=1 to 20000 do
for j:=1 to f[i] do
begin
x:=x+1;
a[x]:=i;
end;
l1:=1;r1:=x;l2:=1;r2:=0;
for i:=1 to n-1 do
begin
min:=maxlongint;
if (a[l1]+a[l1+1] -
0
编译通过...
├ 测试数据 01：答案正确... 0ms
├ 测试数据 02：答案正确... 0ms
├ 测试数据 03：答案正确... 0ms
├ 测试数据 04：答案正确... 0ms
├ 测试数据 05：答案正确... 0ms
├ 测试数据 06：答案正确... 0ms
├ 测试数据 07：答案正确... 0ms
├ 测试数据 08：答案正确... 0ms
├ 测试数据 09：答案正确... 0ms
├ 测试数据 10：答案正确... 0ms
---|---|---|---|---|---|---|---|-
Accepted 有效得分：100 有效耗时：0ms刚刚学了一手 用两个队列优化O(n)，这样新数生成后不必排序
程序打的很乱，不理解可以模拟运行一下
初始的排序用记数排序，效率介于O(n)~~小常数
所以总效率O(n)！//
var a,b:array[0..10001] of longint;
t:array[0..20000]of longint;
x,i,n,sum,min:longint;
head,tail:record
a:longint;
b:longint;
end;
c1,c2,c3:boolean;procedure tongsort;
var k:longint;
begin
k:=0;
for i:=1 to 20000 do
begin
while t[i]>0 do
begin
inc(k);
a[k]:=i;
dec(t[i]);
end;
if k=n then exit;
end;begin
readln(n);
fillchar(t,sizeof(t),0);
fillchar(a,sizeof(a),0);
fillchar(b,sizeof(b),0);
for i:=1 to n do
begin
read(x);
inc(t[x]);
end;
tongsort;
head.a:=1;
head.b:=1; tail.b:=0;
c1:=false; c2:=false; c3:=false;for i:=1 to n-1 do
begin
min:=maxlongint;
if (a[head.a]+b[head.b]0)and(b[head.b]>0)
then begin
min:=a[head.a]+b[head.b];
c1:=true;
end;if (a[head.a+1]+a[head.a]0)
then begin
min:=a[head.a+1]+a[head.a];
c2:=true;
c1:=false;
end;
if (b[head.b+1]+b[head.b]0)
then begin
min:=b[head.b+1]+b[head.b];
c3:=true;
c2:=false;
c1:=false;
end;
if c1 then begin
inc(head.a);
inc(head.b);
end;
if c2 then inc(head.a,2);
if c3 then inc(head.b,2);sum:=sum+min;
inc(tail.b);
b[tail.b]:=min;
c1:=false; c2:=false; c3:=false;
end;
writeln(sum);
end. -
0
guori12321 LV 8 @ 2009-07-19 08:54:51
总算AC了，开int64数组总会有莫名其妙的错误...
注意，快排两次的话会有一半的点超时，快排+插入排序就AC了 -
0
Under raker LV 4 @ 2009-06-29 19:25:22
program hebing(input,output);
var
a:array[1..10000] of longint;
i,s,b:longint;
n:1..10000;procedure order(l,r:longint);
var
i,j,mid,tmp:longint;
begin
i:=l;
j:=r;
mid:=a[(l+r) div 2];
repeat
while a[i] -
0
编译通过...
├ 测试数据 01：运行时错误...| 错误号: 157 | 未知媒介类型
├ 测试数据 02：答案正确... 0ms
├ 测试数据 03：运行时错误...| 错误号: 128 |
├ 测试数据 04：运行时错误...| 错误号: 128 |
├ 测试数据 05：运行时错误...| 错误号: 251 |
├ 测试数据 06：运行时错误...| 错误号: 229 |
├ 测试数据 07：运行时错误...| 错误号: 50 |
├ 测试数据 08：运行时错误...| 错误号: 84 |
├ 测试数据 09：运行时错误...| 错误号: 27 |
├ 测试数据 10：运行时错误...| 错误号: 106 | 无效数字格式
---|---|---|---|---|---|---|---|
真！！！！！！！！！！！！！！！！！！ -
0
编译通过...
├ 测试数据 01：运行超时...
├ 测试数据 02：答案正确... 0ms
├ 测试数据 03：运行超时...
├ 测试数据 04：运行超时...
├ 测试数据 05：运行超时...
├ 测试数据 06：运行超时...
├ 测试数据 07：运行超时...
├ 测试数据 08：运行超时...
├ 测试数据 09：运行超时...
├ 测试数据 10：运行超时...
---|---|---|---|---|---|---|---|-
Unaccepted 有效得分：10 有效耗时：0ms正宗的石子归并竟然超时？？
编译通过...
├ 测试数据 01：答案正确... 197ms
├ 测试数据 02：答案正确... 0ms
├ 测试数据 03：答案正确... 0ms
├ 测试数据 04：答案正确... 0ms
├ 测试数据 05：答案正确... 0ms
├ 测试数据 06：答案正确... 0ms
├ 测试数据 07：答案正确... 197ms
├ 测试数据 08：答案正确... 197ms
├ 测试数据 09：答案正确... 197ms
├ 测试数据 10：答案正确... 197ms
---|---|---|---|---|---|---|---|-
Accepted 有效得分：100 有效耗时：985ms原来不是石子归并，只是相当于石子归并的“贪心形式”——石子归并每堆石子的顺序不能改，而这里的果子的可以改。
-
0
program hebingguozi(input,output);
var s,k,y,n,i,j:longint;
d:boolean;
a:array[1..2,1..10000]of longint;procedure ex;
begin
k:=a[y,i];
j:=i;
repeat
d:=true;
if a[y,j div 2]>k then begin
a[y,j]:=a[y,j div 2];
j:=j div 2;
d:=false;
end;
until (j=1)or d;
a[y,j]:=k;
end;begin
readln(n);
y:=1;
read(a[y,1]);
for i:=2 to n do
begin
read(a[y,i]);
ex;
end;
while n1 do
begin
if n>=3 then
begin
if a[y,2]>a[y,3] then begin
a[y,3]:=a[y,3]+a[y,1];
s:=s+a[y,3];
end
else begin
a[y,2]:=a[y,2]+a[y,1];
s:=s+a[y,2];
end;
y:=3-y;
dec(n);
if n1 then
a[y,1]:=a[3-y,2];
for i:=2 to n do begin
a[y,i]:=a[3-y,i+1];
ex;
end;
end
else begin
a[y,1]:=a[y,1]+a[y,2];
dec(n);
s:=s+a[y,1];
end;
end;
writeln(s);
end.编译通过...
├ 测试数据 01：答案正确... 634ms
├ 测试数据 02：答案正确... 0ms
├ 测试数据 03：答案正确... 0ms
├ 测试数据 04：答案正确... 0ms
├ 测试数据 05：答案正确... 41ms
├ 测试数据 06：答案正确... 72ms
├ 测试数据 07：答案正确... 681ms
├ 测试数据 08：答案正确... 681ms
├ 测试数据 09：答案正确... 650ms
├ 测试数据 10：答案正确... 634ms堆排......
-
0
var a:array[1..100000] of QWORD;
n,i,j:integer;
ans,temp:QWORD;procedure siftdown(i:integer);
var done:boolean;
t:QWORD;
begin
done:=false;
while ( i < n ) and ( not done ) do
begin
i:= i * 2 ;
if ( i + 1 a) then i:=i+1;
if ( i a[i]) then
begin
t:=a[i div 2];
a[i div 2]:=a[i];
a[i]:=t;
end
else done:=true;
end;
end;procedure siftup(i:integer);
var done:boolean;
t:QWORD;
begin
done:=false;
while ( i > 1 ) and ( not done ) do
begin
if ( i > 1 ) and ( a[i div 2 ] > a[i] ) then
begin
t:=a[i div 2];
a[i div 2]:=a[i];
a[i]:=t;
end
else done:=true;
i:= i div 2 ;
end;
end;procedure dele(i:integer);
var x,y:integer;
begin
a[1]:=a[n];
n:=n-1;
siftdown(1);
end;
procedure add(x:QWORD;var n:integer);
begin
inc(n);
a[n]:=x;
siftup(n);
end;function getmin:QWORD;
var x,y:integer;
begin
x:=a[1];
dele(1);
exit(x);
end;begin
readln(n);
for i:= 1 to n do
read(a[i]);
for i:= n div 2 downto 1 do
siftdown(i);
ans:=0;
for i:= 1 to n - 1 do
begin
temp:=getmin+getmin;
add(temp,n);
ans:=ans+temp;
end;
writeln(ans);
end.帮忙看下。。。n超过2000就error 201
-
0
wycwashing LV 4 @ 2009-06-18 17:32:32
It's amazing!yeah!
编译通过...
├ 测试数据 01：答案正确... 0ms
├ 测试数据 02：答案正确... 0ms
├ 测试数据 03：答案正确... 0ms
├ 测试数据 04：答案正确... 0ms
├ 测试数据 05：答案正确... 0ms
├ 测试数据 06：答案正确... 0ms
├ 测试数据 07：答案正确... 0ms
├ 测试数据 08：答案正确... 0ms
├ 测试数据 09：答案正确... 0ms
├ 测试数据 10：答案正确... 0ms
---|---|---|---|---|---|---|---|-
Accepted 有效得分：100 有效耗时：0msprogram xx;
var n, ans, i, j, k, s : longint;
a, b : array[0..10000] of longint;
point:
record
a, b : integer;
tip : integer;
end;procedure qsort(l, r: longint);
var i, j, mid, t: longint;
begin
i := l; j := r; mid := a[(l+r) div 2];
repeat
while a[i] < mid do inc(i);
while a[j] > mid do dec(j);
if i j;
if l < j then qsort(l, j);
if i < r then qsort(i, r);
end;begin
readln(n);
for i:= 1 to n do read(a[i]);
qsort(1, n);point.a := 3; point.b := 1; point.tip := 1;
b[1] := a[1] + a[2]; ans := a[1] + a[2];
for i:= 2 to n-1 do
begin
s := 0;
for j:= 1 to 2 do
if ((a[point.a] < b[point.b]) or (point.b > point.tip)) and
(point.a -
0
vijos 的测试机果然不错。。机器上160ms 竟然0ms AC
改得我要吐了！！！！！
编译通过...
├ 测试数据 01：答案正确... 0ms
├ 测试数据 02：答案正确... 0ms
├ 测试数据 03：答案正确... 0ms
├ 测试数据 04：答案正确... 0ms
├ 测试数据 05：答案正确... 0ms
├ 测试数据 06：答案正确... 0ms
├ 测试数据 07：答案正确... 0ms
├ 测试数据 08：答案正确... 0ms
├ 测试数据 09：答案正确... 0ms
├ 测试数据 10：答案正确... 0ms
---|---|---|---|---|---|---|---|-
Accepted 有效得分：100 有效耗时：0msvar count,a1,b1,num,b2,c1,i1,i,n,m:longint;
a:array[1..10001] of longint;
b:array[1..20001] of longint;
c:array[1..20000] of longint;
procedure qs(l,r:longint);
var i,j,mid,tmp:longint;
begin
i:=l;j:=r;mid:=a[(l+r) div 2];
repeat
while a[i]< mid do inc(i);while mid < a[j] do dec(j);
if ij;
if l < j then qs(l,j);if i < r then qs(i,r);
end;
procedure min(xx,yy:longint);
var f:boolean;
begin
f:=false;m:=1;count:=maxlongint;
if (xx -
0
program p1097;
var a:array[0..20000]of longint;
i,n:integer;
j,q:longint;
procedure cp;
var i,j:integer;
begin
for i:=2 to n do begin
j:=i;
a[0]:=a[i];
while a[j-1]>a[0] do
begin
a[j]:=a[j-1];
dec(j);
end;
a[j]:=a[0];
end;
end;
procedure kp(l,r:integer);
var i,j,x,y:integer;
begin
i:=l;
j:=r;
x:=a[(l+r) div 2];
repeat
while a[i] -
0
type
arr=array[1..10000] of longint;
var a:arr;
ex,m,n,e,i,j:longint;
f:qword;begin
readln(n);
for i:=1 to n do read(a[i]);
for i:=n downto 1 do
for j:=n downto i do
if a[j]>a[i] then begin
e:=a[i];
a[i]:=a[j];
a[j]:=e;
end;
f:=0;while n>1 do
begin
a[n-1]:=a[n]+a[n-1];
a[n]:=0;
f:=f+a[n-1];
for m:=n-1 downto 2 do if a[m]>a[m-1] then begin
ex:=a[m];
a[m]:=a[m-1];
a[m-1]:=ex;
end;dec(n);
end;
writeln(f);
end.
wilsonlym
LV 8
@ 2009-07-18 17:22:24
