Cod sursa(job #607126)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 10 august 2011 20:46:20
Problema Secv Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.33 kb
Program secv;
var a,b,c:array [1..5001] of longint;
    i,j,min,k,s,t,n:longint;
    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-k+1 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;
while i<=n 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 (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');
close(fo);
end.