Cod sursa(job #203472)

Utilizator GavrilaVladGavrila Vlad GavrilaVlad Data 16 august 2008 21:19:54
Problema Secv Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.62 kb
var v,w,a,b:array[0..5000]of longint;
    n,i,j,k,e,f,g,l:longint;
    f1:text;
procedure merge(p,r:longint);
var q:longint;
begin
   q:=(p+r)div 2;
   if p<q then merge(p,q);
   if q+1<r then merge(q+1,r);
   for i:=p to r do
   begin
   a[i]:=v[i];
   b[i]:=w[i];
   end;
   e:=p;
   f:=q+1;
   g:=p;
   while(e<=q)and(f<=r)do
   if a[e]<=a[f] then begin v[g]:=a[e];
                            w[g]:=b[e];
                            e:=e+1;
                            g:=g+1;
                      end
                 else begin v[g]:=a[f];
                            w[g]:=b[f];
                            f:=f+1;
                            g:=g+1;
                      end;
   while(e<=q)do
   begin
   v[g]:=a[e];
   w[g]:=b[e];
   e:=e+1;
   g:=g+1;
   end;
   while(f<=r)do
   begin
   v[g]:=a[f];
   w[g]:=b[f];
   f:=f+1;
   g:=g+1;
   end;
end;
begin
   assign(f1,'secv.in');
   reset(f1);
   read(f1,n);
   v[0]:=-1;
   for i:=1 to n do
   begin
   read(f1,v[i]);
   w[i]:=i;
   end;
   close(f1);
   merge(1,n);
   v[n+1]:=-1;
   for i:=1 to n+1 do
   if(v[i-1]<>v[i])then begin k:=k+1;
                              a[k]:=i;
                              b[k]:=i;
                        end;
   l:=-1;
   for i:=a[1] to a[2]-1 do
   begin
   f:=0;
   for j:=2 to k-1 do
   begin
   while(w[b[j]]<w[b[j-1]])and(b[j]<a[j+1])do
   b[j]:=b[j]+1;
   if b[j]>=a[j+1] then f:=1;
   end;
   if(f=0)and((l=-1)or(w[b[k-1]]-w[i]+1<l))then l:=w[b[k-1]]-w[i]+1;
   b[1]:=b[1]+1;
   end;
   assign(f1,'secv.out');
   rewrite(f1);
   writeln(f1,l);
   close(f1);
end.