比赛 20110724 评测结果 AWWEEEEEEE
题目名称 并行 最终得分 10
用户昵称 Yoghurt 运行时间 0.000 s
代码语言 Pascal 内存使用 0.00 MiB
提交时间 2011-07-24 12:36:59
显示代码纯文本
{
Problem:
Arithmetic Analysis:
Writer:
Data:
Remark:
AC:
}
program parellel;
const
        filename='parellel';
        maxn=100;
var
        a,b,tot:array[0..maxn] of longint;
        n,dis,min:longint;

procedure qsorta(l,r:longint);
var
        i,j,mid,temp: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 i<=j then
                begin
                        temp:=a[i];
                        a[i]:=a[j];
                        a[j]:=temp;
                        inc(i); dec(j);
                end;
        until i>j;
        if l<j then qsorta(l,j);
        if i<r then qsorta(i,r);
end;

procedure qsortb(l,r:longint);
var
        i,j,mid,temp:longint;
begin
        i:=l; j:=r;
        mid:=b[(l+r) div 2];
        repeat
                while b[i]<mid do inc(i);
                while mid<b[j] do dec(j);
                if i<=j then
                begin
                        temp:=b[i];
                        b[i]:=b[j];
                        b[j]:=temp;
                        inc(i); dec(j);
                end;
        until i>j;
        if l<j then qsortb(l,j);
        if i<r then qsortb(i,r);
end;

function minn(a,b:longint):longint;
begin
        if a<b then exit(a)
               else exit(b);
end;

procedure check(x:longint);
var
        i,k:longint;
begin
        k:=1;
        for i:=1 to n-1 do
        begin
                if tot[i-1]>1 then
                        dis:=dis+abs(a[i-1]-a[i])*(tot[i-1]-1);
                while a[k]<=b[i] do
                        if k<>x then
                        begin
                                inc(tot[i]);
                                inc(k);
                                inc(dis,abs(b[i]-a[k]));
                        end else
                                inc(k);
        end;
        while k<=n do
                if k<>x then
                begin
                        dis:=dis+abs(a[k]-b[n-1]);
                        inc(k);
                end else
                        inc(k);
        for i:=1 to n-1 do
                if a[x]<b[i] then break;
        dis:=dis+minn(abs(a[x]-b[i]),abs(a[x]-b[i-1]));
end;

procedure solve;
var
        i:longint;
begin
        readln(n);
        while n<>0 do
        begin
                for i:=1 to n do read(a[i]);
                readln;
                for i:=1 to n-1 do read(b[i]);
                readln;
                qsorta(1,n);
                qsortb(1,n-1);
                min:=maxlongint;
                for i:=1 to n do
                begin
                        dis:=0;
                        check(i);
                        if dis<min then min:=dis;
                end;
                writeln(min);
                readln(n);
        end;
end;

begin
        assign(input,filename+'.in'); reset(input);
        assign(output,filename+'.out'); rewrite(output);

        solve;

        close(input); close(output);
end.