Cod sursa(job #772633)

Utilizator hungntnktpHungntnktp hungntnktp Data 30 iulie 2012 13:12:10
Problema Secventa Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.13 kb
USES math;
CONST
        tfi     =       'secventa.in';
        tfo     =       'secventa.out';
        nmax    =       500000;
TYPE
        arr1 = array [0..nmax] of longint;
VAR
        fi,fo:text;
        n,k,f,r,d,c,t:longint;
        res:int64;
        a,q: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;
{_______________________________________}
function find(x:longint):longint;
var i,j,mid,kq:longint;
        Begin
                i:=f;
                j:=r;
                kq:=0;
                while i<=j do
                begin
                        mid:=(i+j) div 2;
                        if a[q[mid]]>x then
                        begin
                                kq:=mid;
                                j:=mid-1;
                        end
                                else i:=mid+1;
                end;
                exit(kq);
        End;
{_______________________________________}
function finddau(x,vt:longint):longint;
var i,j,kq:longint;
        Begin
                i:=vt;
                kq:=0;
                while (i>vt-k) and (a[i]>=x) do
                begin
                        kq:=i;
                        dec(i);
                end;
                exit(kq);
        End;
{_______________________________________}
procedure push(x:longint);
        Begin
                inc(r);
                q[r]:=x;
        End;
{_______________________________________}
procedure xuli;
var i,j:longint;
        Begin
                res:=-16000000000;
                d:=0;
                c:=0;
                f:=1;
                r:=0;
                push(1);
                for i:=1 to n do
                begin
                        if a[i]>a[q[r]] then push(i);
                        if f<=r then
                        begin
                                j:=find(a[i]);
                                if j>0 then
                                begin
                                        r:=j;
                                        q[r]:=i;
                                end;
                                while (f<r) and (q[f]<=i-k) do inc(f);
                                if i>=k then
                                        if res<a[q[f]] then
                                        begin
                                                res:=a[q[f]];
                                                d:=finddau(a[q[f]],i);
                                                if d>0 then d:=min(d,q[f])
                                                        else d:=q[f];
                                                c:=i;
                                        end;
                        end;
                end;
        End;
{_______________________________________}
BEGIN
        assign(fo,tfo);rewrite(fo);
        nhap;
        xuli;
        write(fo,d,' ',c,' ',res);
        close(fo);
END.