var ans:int64;
suma,sumb,sumab,a,b,num,col,id:array[1..100005] of int64;
n,mm:longint;
procedure swap(var a,b:int64);
var t:int64;
begin
t:=a; a:=b; b:=t;
end;
procedure qsort(l,r:longint);
var midc,midid:int64;
i,j:longint;
begin
i:=l; j:=r;
midc:=col[(l+r) div 2];
midid:=id[(l+r) div 2];
while i<=j do
begin
while (col[i]<midc) or
(col[i]=midc) and (id[i] mod 2<midid mod 2) do inc(i);
while (col[j]>midc) or
(col[j]=midc) and (id[j] mod 2>midid mod 2) do dec(j);
if i<=j then
begin
swap(id[i],id[j]);
swap(col[i],col[j]);
swap(num[i],num[j]);
inc(i); dec(j);
end;
if l<j then qsort(l,j);
if i<r then qsort(i,r);
end;
procedure solve(m:longint);
var p,i:longint;
begin
p:=10007;
for i:=1 to m do
begin
suma[i]:=(suma[i-1]+a[i]) mod p;
sumb[i]:=(sumb[i-1]+b[i]) mod p;
sumab[i]:=(sumab[i-1]+a[i]*b[i] mod p) mod p;
end;
for i:=1 to m-1 do
ans:=(ans+a[i]*b[i] mod p*(m-i)+
a[i]*sumb[m]-sumb[i]+p) mod p+
b[i]*(suma[m]-suma[i]+p) mod p+
(sumab[m]-sumab[i]+p)) mod p;
end;
begin
readln(n,mm);
for i:=1 to n do
begin
read(num[i]);
id[i]:=i;
end;
for i:=1 to n do
read(col[i]);
qsort(1,n);
last:=1;
for i:=1 to n+1 do
if (col[i]<>col[i-1]) or (id[i] mod 2<>id[i-1] mod 2) then
begin
for j:=last to i-last do
begin
a[j]:=num[j+last-1];
b[j]:-id[j+last-1];
end;
solve(i-last);
last:=i;
end;
writeln(ans);
end.

求助求助

这么长连神仙也看不出来，错误信息？

挖一下