Cod sursa(job #607128)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 10 august 2011 21:08:44
Problema Secv Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.41 kb
Program secv;
var a,b,c:array [1..5001] of longint;
    i,j,min,k,s,t,n:integer;
    ok:boolean;
    fi,fo:text;
procedure sort(l,r:longint);
 var k,i,j,y:longint;
 begin
  i:=l; j:=r;
   k:=b[(l+r) div 2];
 repeat
  while b[i]<k do inc(I);
   while b[j]>k do dec(j);
 if i<=j then
              begin
               y:=b[i];
                b[i]:=b[j];
                  b[j]:=y;
                     inc(i); dec(j);
              end;
 until i>=j;
  if l<j then sort(l,j);
   if i<r then sort(i,r);
 end;
begin
assign(fi,'secv.in');
 assign(fo,'secv.out');
reset(fi);
 rewrite(fo);
readln(fi,n);
min:=10000;
for i:=1 to n do begin
                  read(fi,a[i]);
                  b[i]:=a[i];
                  end;
 sort(1,n);
 c[1]:=b[1]; k:=1;
for i:=2 to n do
 if b[i]<>b[i-1] then begin
    inc(k);
    c[k]:=b[i];
    end;
i:=1; t:=1;
if n>1 then  begin
while i<=n-k+1 do
 if a[i]<>c[t] then inc(i)
 else begin
  ok:=true; inc(t);  j:=i; s:=i;
  repeat
   inc(j);
   if a[j]=c[t] then begin
                      inc(t);
                      ok:=false;
                      end
   else if (a[j]=c[1]) and (ok) then i:=j;
   until (n-j<=k-t) or (t=k+1) or (j=n);
   if (t=k+1) and (j-s+1<min) then min:=j-s+1;
   t:=1;
   if i=s then inc(i);
   end;
 if min<>10000 then write(fo,min)
  else write(fo,'-1');
              end
  else write(fo,n);
close(fo);
end.