Cod sursa(job #408517)

Utilizator hungntnktpHungntnktp hungntnktp Data 3 martie 2010 05:29:14
Problema Deque Scor 60
Compilator fpc Status done
Runda Arhiva educationala Marime 1.49 kb
const fi        =       'deque.in';
     fo         =       'deque.out';
     maxn       =       5000000;
var a,heap   :       array[0..maxn] of longint;
    nheap,n,k       : longint;
    res : int64;
    tf :text;

procedure init;
var i : longint;
 begin
  assign(tf,fi);
  reset(tf);
  Readln(tf,n,k);
  for i := 1 to n do Read(tf,a[i]);
  close(tf);
 end;

procedure swap(var i,j : longint);
var t : longint;
 begin
  t := i; i := j; j := t;
 end;

procedure push(u:longint);
var i,j : longint;
 begin
  inc(nheap);
  heap[nheap] := u; j := nheap; i := j div 2;
  while i >= 1 do
   begin
    if a[heap[i]] < a[heap[j]] then break;
    swap(heap[i],heap[j]);
    j := i; i := j div 2;
   end;
 end;

procedure pop(var u : longint);
var i,j : longint;
 begin
  u := heap[1];
  heap[1] := heap[nheap];
  dec(nheap);
  i := 1; j := 2;
  While j <= nheap do
   begin
    if (j < nheap) and (a[heap[j+1]] < a[heap[j]]) then inc(j);
    if a[heap[i]] < a[heap[j]] then break;
    swap(heap[i],heap[j]);
    i := j; j := i * 2;
   end;
 end;

procedure process;
var i,j,d : longint;
 begin
  d := 0;
  for i := 1 to k-1 do push(i);
  for i := k to n do
   begin
    push(i);
    inc(d);
    j := heap[1];
    while j < d do
     begin
      pop(j);
      j := heap[1];
     end;
    res := res + a[j];
   end;
 end;

procedure result;
 begin
  assign(tf,fo);
  rewrite(tf);
  writeln(tf,res);
  close(tf);
 end;

begin
 init;
 process;
 result;
end.