Cod sursa(job #784506)

Utilizator hungntnktpHungntnktp hungntnktp Data 6 septembrie 2012 10:26:35
Problema Deque Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 2.38 kb
Const
        tfi     =       'deque.in';
        tfo     =       'deque.out';
        Nmax    =       10000000;
Type
        arr1    =       array[1..Nmax] of longint;
Var
        fi,fo         :       text;
        N,K,nheap     :       longint;
        res           :       int64;
        A,H,pos       :       arr1;
(*------------------------------------*)
Procedure nhap;
  var
        i       :       longint;
  begin
        assign(fi,tfi); reset(fi);
             read(fi,N,K);
             for i := 1 to n do
                read(fi,A[i]);
        close(fi);
  end;
(*------------------------------------*)
Procedure doicho(var x,y : longint);
  var
        tg      :       longint;
  begin
        tg := x;
        x := y;
        y := tg;
  end;
(*------------------------------------*)
Procedure upheap(i : longint);
  begin
     if (i = 1) or (A[H[i]] >= A[H[i div 2]]) then exit;
     doicho(H[i],H[i div 2]);
     doicho(pos[H[i]],pos[H[i div 2]]);
     upheap(i div 2);
  end;
(*------------------------------------*)
Procedure downheap(i : longint);
  var
        j       :       longint;
  begin
     j := i*2;
     if j > nheap then exit;
     if (j < nheap) and (A[H[j]] > A[H[j+1]]) then inc(j);
     if A[H[i]] > A[H[j]] then
        begin
           doicho(H[i],H[j]);
           doicho(pos[H[i]],pos[H[j]]);
           downheap(j);
        end;
  end;
(*------------------------------------*)
Procedure push(i : longint);
  begin
     inc(nheap);
     H[nheap] := i;
     pos[i] := Nheap;
     upheap(nheap);
  end;
(*------------------------------------*)
Function pop : longint;
  begin
     pop := H[1];
     H[1] := nheap;
     pos[H[nheap]] := 1;
     downheap(1);
  end;
(*------------------------------------*)
Procedure xuly;
 var
        i,tg  :       longint;
 begin
        nheap := 0;
        For i := 1 to n do
           begin
              push(i);
              while H[1] <= i - k do
                begin
                   tg := pop;
                end;
              if i >= k then res := res + A[H[1]];
           end;
 end;
(*------------------------------------*)
Procedure inkq;
 begin
    assign(fo,tfo); rewrite(fo);
       write(fo,res);
    close(fo);
 end;
(*------------------------------------*)
(*------------------------------------*)
BEGIN
   nhap;
   xuly;
   inkq;
END.