Cod sursa(job #36129)

Utilizator ProtomanAndrei Purice Protoman Data 22 martie 2007 23:56:20
Problema Secv Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.63 kb
var f1,f2:text; a,v,y:array[1..5000] of longint; s,i,j,ad,n,max,min,ult,h,t,m,g,ind:longint; x:array[1..15000000] of boolean;

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

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

begin
        assign(f1,'secv.in');
        reset(f1);
        assign(f2,'secv.out');
        rewrite(f2);
        read(f1,n);
        min:=maxlongint;
        max:=-maxlongint;
        t:=min;
        for i:=1 to n do begin
                read(f1,y[i]);
                if x[y[i]]=false then begin inc(s); a[s]:=y[i]; x[y[i]]:=true; end;
                if y[i]<min then begin min:=y[i]; j:=0; end;
                if y[i]=min then begin inc(j); v[j]:=i; end;
                if max<y[i] then max:=y[i];
                if max=y[i] then ult:=i;
        end;
        quick(1,s);
        a[s+1]:=-1;
        m:=j;
        for j:=1 to m do begin
                h:=2;
                ind:=a[2];
                ad:=0;
                for i:=v[j] to ult do begin
                        if y[i]=ind then begin inc(h); ind:=a[h];end;
                        if ind=-1 then begin g:=i; ad:=1; break; end;
                end;
                if (g-v[j]+1<t)and(ad=1) then t:=g-v[j]+1;
        end;
        if t=maxlongint then t:=-1;
        write(f2,t);
        close(f1);
        close(f2);
end.