Cod sursa(job #34186)

Utilizator vanila0406Ionescu Victor vanila0406 Data 20 martie 2007 12:42:25
Problema Oo Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.52 kb
program oo;
type ou=record
        s:longint;
        p:longint;
end;
var f,g:text;
        viz:array[1..100001] of byte;
        n:longint;
        v:array[1..100001] of ou;


procedure iofile;
var i,x,y:longint;
begin
        assign(f,'oo.in');
        reset(f);
        assign(g,'oo.out');
        rewrite(g);
        readln(f,n);
        read(f,v[1].s);
        v[1].p:=1;
        y:=v[1].s;
        for i:=2 to n do
                begin
                        read(f,v[i].s);
                        x:=v[i].s;
                        v[i].s:=x+y;
                        v[i].p:=i;
                        y:=x;
                end;
        v[1].s:=v[1].s+x;
        close(f);
end;


procedure pozitie(var m:longint;p,u:longint);
var di,dj,i,j,aux:longint;
        aux1:ou;
begin
        i:=p;
        j:=u;
        di:=0;
        dj:=-1;
        while i<j do
                begin
                        if v[i].s<v[j].s then
                                begin
                                        aux:=di;
                                        di:=-dj;
                                        dj:=-aux;
                                        aux1:=v[i];
                                        v[i]:=v[j];
                                        v[j]:=aux1;
                                end;
                        i:=i+di;
                        j:=j+dj;
                end;
        m:=i;
end;



procedure quick(p,u:longint);
var m:longint;
begin
        if p<u then
                begin
                        pozitie(m,p,u);
                        quick(p,m-1);
                        quick(m+1,u);
                end;
end;



procedure prel;
var i,p,y,s:longint;
begin
        quick(1,n);
        s:=0;
        fillchar(viz,sizeof(viz),0);
        p:=1;
        while p<=n do
                begin
                        s:=s+v[p].s;
                        y:=v[p].p+1;
                        if y>n then y:=y mod n;
                        viz[v[p].p]:=1;
                        viz[y]:=1;
                        inc(y);
                        if y>n then y:=y mod n;
                        viz[y]:=1;
                        y:=v[p].p-1;
                        if y<1 then y:=n+y;
                        viz[y]:=1;
                        dec(y);
                        if y<1 then y:=n+y;
                        viz[y]:=1;
                        while (viz[v[p].p]=1)and(p<=n) do
                              inc(p);
                end;
        writeln(g,s);
        close(g);
end;



begin
        iofile;
        prel;
end.