Cod sursa(job #72420)

Utilizator mlazariLazari Mihai mlazari Data 13 iulie 2007 20:13:30
Problema Secventa 2 Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.25 kb
Program Secv2;
var S : array[0..50001] of integer;
    N,K,start,finish,Sum : longint;
    Smax,Fmax : array[1..50001] of longint;

procedure Citeste;
var Intrare : text;
    i : longint;
begin
  assign(Intrare,'secv2.in');
  reset(Intrare);
  readln(Intrare,N,K);
  for i:=1 to N do read(Intrare,S[i]);
  close(Intrare);
end;

procedure Init;
var i : longint;
begin
  for i:=1 to N do
   begin
     Smax[i]:=0;
     Fmax[i]:=0;
   end;
  start:=0;
  finish:=0;
  Sum:=0;
  S[0]:=-1;
  S[N+1]:=1;
  Smax[N+1]:=0;
  Fmax[N+1]:=N;
end;

procedure Update(st,fine,suma : longint);
begin
  start:=st;
  finish:=fine;
  Sum:=suma;
end;

procedure Process(x : longint);
var SumMax,SC,fine,i : longint;
begin
  fine:=x;
  SumMax:=S[x];
  SC:=S[x];
  for i:=x+1 to N do
   begin
     SC:=SC+S[i];
     if SC>SumMax then
      begin
        fine:=i;
        SumMax:=SC;
      end;
     if SC<=0 then break;
   end;
  Smax[x]:=SumMax;
  Fmax[x]:=fine;
  if finish-start+1<K then Update(x,fine,SumMax)
   else
    if (fine-x+1>=K) and (SumMax>Sum) then Update(x,fine,SumMax);
  SC:=0;
  for i:=fine downto x+1 do
   begin
     SC:=SC+S[i];
     Smax[i]:=SC;
     Fmax[i]:=fine;
   end;
  SC:=SumMax;
  for i:=x-1 downto 1 do
   if S[i]>0 then break
    else
     begin
       SC:=SC+S[i];
       Smax[i]:=SC;
       Fmax[i]:=fine;
     end;
end;

procedure s_max(x : longint; var ss,ff : longint);
begin
  if Smax[x]>0 then
   begin
     ss:=Smax[x];
     ff:=Fmax[x];
   end
   else
    begin
      ss:=0;
      ff:=x-1;
    end;
end;

procedure Calculeaza;
var i,Summa,ss,ff : longint;
begin
  Init;
  i:=1;
  while S[i]<0 do i:=i+1;
  while i<N do
   begin
     Process(i);
     i:=Fmax[i]+1;
     while S[i]<0 do i:=i+1;
   end;
  if finish-start+1<K then
   begin
     Sum:=-maxlongint;
     Summa:=0;
     for i:=1 to K do Summa:=Summa+S[i];
     for i:=K to N do
      begin
        s_max(i+1,ss,ff);
        if Summa+ss>Sum then Update(i-K+1,ff,Summa+ss);
      end;
   end;
end;

procedure Scrie;
var Iesire : text;
begin
  assign(Iesire,'secv2.out');
  rewrite(Iesire);
  write(Iesire,start,' ',finish,' ',Sum);
  close(Iesire);
end;

begin
  Citeste;
  Calculeaza;
  Scrie;
end.