Cod sursa(job #25767)

Utilizator raduzerRadu Zernoveanu raduzer Data 4 martie 2007 14:30:06
Problema Buline Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.21 kb
var a,b,c,d:array[1..200010]of longint;
    n,i,j,s,p,l,max,q,m,x,z,t,y:longint;
begin
     assign(input,'buline.in');
     reset(input);
     assign(output,'buline.out');
     rewrite(output);
     readln(n);
     for i:=1 to n do
     begin
          readln(a[i],b[i]);
          if (b[i]=0)and(j=0) then j:=i;
     end;
     if j=0 then
     begin
          j:=1;
          q:=1;
     end;
     x:=j-1;
     z:=0;
     j:=j-1;
     if x<1 then x:=n;
     s:=0;
     m:=0;
     repeat
          j:=j+1;
          if j>n then j:=1;
          if b[j]=q then
          begin
               if q=0 then s:=s-a[j]
                      else s:=s+a[j];
               z:=z+1;
          end
          else
          begin
               m:=m+1;
               c[m]:=s;
               d[m]:=z;
               if q=1 then q:=0
                      else q:=1;
               if q=0 then s:=-a[j]
                      else s:=a[j];
               z:=1;
          end;
          if j=x then
          begin
               m:=m+1;
               c[m]:=s;
               d[m]:=z;
               z:=0;
          end;

     until j=x;
     n:=m;
     s:=0;
     for i:=1 to m do a[i]:=c[i];
     max:=0;
     q:=0;
     for i:=1 to n do
     begin
          if b[i]=1 then s:=a[i]
                    else s:=a[i];
          if s>max then
               begin
                    max:=s;
                    p:=i;
                    l:=d[i];
                    t:=i;
                    y:=i;

               end;
          j:=i+1;
          if j>n then j:=1;
          while j<>i do
          begin
               if b[j]=1 then s:=s+a[j]
                         else s:=s+a[j];
               q:=q+1;
               if s>max then
               begin
                    max:=s;
                    p:=i;
                    l:=d[j];
                    t:=i;
                    y:=j;
               end;
               j:=j+1;
               if j>n then j:=1;
          end;
     end;
     l:=0;
     i:=t-1;
     while i<>y do
     begin
          i:=i+1;
          if i>n then i:=1;
          l:=l+d[i];

     end;
     writeln(max,' ',p,' ',l);
close(output);
end.