Cod sursa(job #152660)

Utilizator cezar305Mr. Noname cezar305 Data 9 martie 2008 17:38:08
Problema Lupul Urias si Rau Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.9 kb
{
N - numarul de oi
X - distanta maxima de la care lupul poate alege oi
L - distanta cu care se departeaza oile de lup dupa fiecare alegere

D[] - distanta initiala
A[] - cantitatea de lana
}

program lupu;
type
        sir=array[0..100000] of longint;
var
        f:text;
        d,a,t,h:sir;
        j,n,x,l,i,k,tmax,c:longint;
        heap:sir;
        suma:int64;

function partitie(first,last:longint):longint;
var
        q,i,j,aux:longint;
begin
        q:=t[first];
        i:=first-1;
        j:=last+1;
        while true do begin
                repeat inc(i); until t[i]<=q;
                repeat dec(j); until t[j]>=q;
                if i<j then begin
                        aux:=t[i]; t[i]:=t[j]; t[j]:=aux;
                        aux:=a[i]; a[i]:=a[j]; a[j]:=aux;
                        aux:=d[i]; d[i]:=d[j]; d[j]:=aux;
                end
                else begin
                        partitie:=j;
                        exit;
                end;
        end;
end;


procedure qs(first,last:longint);
var
        q:longint;
begin
        if first<last then begin
                q:=partitie(first,last);
                qs(first,q);
                qs(q+1,last);
        end;
end;

function partitie1(first,last:longint):longint;
var
        q,aux,i,j:longint;
begin
        q:=h[first];
        i:=first-1;
        j:=last+1;
        while true do begin
                repeat inc(i); until h[i]>=q;
                repeat dec(j); until h[j]<=q;
                if i<j then begin
                        aux:=h[i]; h[i]:=h[j]; h[j]:=aux;
                end
                else begin
                        partitie1:=j;
                        exit;
                end;
        end;
end;

procedure qs1(first,last:longint);
var
        q:longint;
begin
        if first<last then begin
                q:=partitie1(first,last);
                qs1(first,q);
                qs1(q+1,last);
        end;
end;

procedure add(valoare:longint);
var
        poz,aux:longint;
begin
        inc(h[0]);
        h[h[0]]:=valoare;
        poz:=h[0];
        while (poz>1) and (h[poz]>h[poz div 2]) do begin
                aux:=h[poz]; h[poz]:=h[poz div 2]; h[poz div 2]:=aux;
                poz:=poz div 2;
        end;
end;

procedure scoate;
var
        poz,aux:longint;
begin
        h[1]:=h[h[0]];
        h[h[0]]:=0;
        dec(h[0]);
        poz:=1;
        while ((h[poz]<h[poz*2]) or (h[poz]<h[poz*2+1])) do begin
                if poz*2+1>h[0] then break;
                if poz*2=h[0] then begin
                        if h[poz]<h[poz*2] then begin
                                aux:=h[poz]; h[poz]:=h[poz*2]; h[poz*2]:=aux;
                                poz:=poz*2;
                        end;
                end;
                if h[poz*2]>h[poz*2+1] then begin
                    aux:=h[poz]; h[poz]:=h[poz*2]; h[poz*2]:=aux;
                    poz:=poz*2;
                end
                else begin
                        aux:=h[poz]; h[poz]:=h[poz*2+1]; h[poz*2+1]:=aux;
                        poz:=poz*2+1;
                end;
        end;
end;

begin
        assign(f,'lupu.in');
        reset(f);
        readln(f,n,x,l);
        for i:=1 to n do begin
            readln(f,d[i],a[i]);
            if d[i]>x then t[i]:=0
            else t[i]:=1+(x-d[i]) div l;
            if t[i]>tmax then tmax:=t[i];
        end;
        close(f);
        qs(1,n);
        suma:=0;
        j:=1;
        c:=0;
        for i:=tmax downto 1 do begin
            while t[j]=i do begin
                add(a[j]);
                inc(j);
            end;
            if h[0]<>0 then begin
            suma:=suma+h[1];
            writeln(h[1]);
            scoate;
            end;
        end;
        assign(f,'lupu.out');
        rewrite(f);
        writeln(f,suma);
        close(f);
end.