Cod sursa(job #163661)

Utilizator ProtomanAndrei Purice Protoman Data 22 martie 2008 14:52:40
Problema Marbles Scor 80
Compilator fpc Status done
Runda preONI 2008, Runda Finala, Clasele 5-8 Marime 3.71 kb
var f1,f2:text;
    i,j,n,m,tip,x,y,l,c,s1,s2,cl,lc,max,x1,x2,aux:longint;
    nr:array[0..100] of longint;
    a:array[0..65,0..100010] of longint;

procedure pozitie(var mj:longint; p,u,cl:longint);
var i,j,di,dj,aux:longint;
begin
        i:=p;
        j:=u;
        di:=0;
        dj:=-1;
        while i<j do
        begin
                if a[cl,i]>a[cl,j] then
                begin
                        aux:=a[cl,i];
                        a[cl,i]:=a[cl,j];
                        a[cl,j]:=aux;
                        aux:=di;
                        di:=-dj;
                        dj:=-aux;
                end;
                i:=i+di;
                j:=j+dj;
        end;
        mj:=i;
end;

procedure quick(p,u,cl:longint);
var mj:longint;
begin
        if p<u then
        begin
                pozitie(mj,p,u,cl);
                quick(p,mj-1,cl);
                quick(mj+1,u,cl);
        end;
end;

function cautaf(p,u,c,x:longint):longint;
var mj:longint;
begin
        mj:=(p+u) div 2;
        cautaf:=0;
        if a[c,mj]=x then
                cautaf:=mj
        else if p<u then
                if a[c,mj]>x then
                        cautaf:=cautaf(p,mj-1,c,x)
                else cautaf:=cautaf(mj+1,u,c,x);
end;

function cautaa(p,u,c,x:longint):longint;
var mj:longint;
begin
        mj:=(p+u) div 2;
        cautaa:=0;
        if (a[c,mj]<x)and(a[c,mj+1]>=x) then
                cautaa:=mj
        else if p<u then
                if a[c,mj]>=x then
                        cautaa:=cautaa(p,mj-1,c,x)
                else cautaa:=cautaa(mj+1,u,c,x);
end;

begin
        assign(f1,'marbles.in');
        reset(f1);
        assign(f2,'marbles.out');
        rewrite(f2);
        read(f1,n,m);
        for i:=1 to n do
        begin
                read(f1,l,c);
                inc(nr[c]);
                a[c,nr[c]]:=l;
        end;
        for i:=1 to 64 do
        begin
                for j:=1 to n div 4 do
                begin
                        x1:=random(nr[i])+1;
                        x2:=random(nr[i])+1;
                        aux:=a[i,x1];
                        a[i,x1]:=a[i,x2];
                        a[i,x2]:=aux;
                end;
                quick(1,nr[i],i);
                a[i,0]:=-maxlongint;
                a[i,nr[i]+1]:=maxlongint;
        end;
        for j:=1 to m do
        begin
                read(f1,tip,x,y);
                max:=0;
                if tip=1 then
                begin
                        if x>y then
                        begin
                                aux:=x;
                                x:=y;
                                y:=aux;
                        end;
                        for i:=1 to 64 do
                        begin
                                s1:=cautaa(1,nr[i],i,x);
                                s2:=cautaa(1,nr[i],i,y+1);
                                if s2-s1>max then
                                        max:=s2-s1;
                        end;
                        writeln(f2,max);
                end;
                if tip=0 then
                begin
                        for i:=1 to 64 do
                        begin
                                s1:=cautaf(1,nr[i],i,x);
                                if s1>0 then
                                begin
                                        cl:=i;
                                        lc:=s1;
                                        break;
                                end;
                        end;
                        a[cl,lc]:=a[cl,lc]+y;
                end;
        end;
        close(f1);
        close(f2);
end.