Cod sursa(job #89432)

Utilizator savimSerban Andrei Stan savim Data 6 octombrie 2007 20:36:02
Problema Secv Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.99 kb
var f1,f2:text;
    b,poz,a:array[1..5000] of longint;
    h,min,p,q,m,n,aa,gas,x,i,j,ok:longint;
begin
assign(f1,'secv.in');
assign(f2,'secv.out');
reset(f1);
rewrite(f2);
readln(f1,n);
for i:=1 to n do
 read(f1,a[i]);

m:=1;b[m]:=a[1];
for i:=2 to n do
 begin
  gas:=0;
  for j:=1 to m do
   if b[j]=a[i] then begin gas:=1;break;end;
  if gas=0 then begin m:=m+1;b[m]:=a[i];end;
 end;
for i:=1 to m-1 do
 for j:=i+1 to m do
  if b[i]>b[j] then
   begin
    x:=b[i];
    b[i]:=b[j];
    b[j]:=x;
   end;
q:=0;
for i:=1 to n do
 if a[i]=b[1] then begin q:=q+1;poz[q]:=i;end;

min:=5000;h:=0;
for i:=1 to q do
 begin
  p:=poz[i];ok:=1;aa:=p;
  for j:=2 to m do
   begin
    gas:=0;
    for x:=p to n do
     if a[x]=b[j] then begin gas:=1;p:=x;break;end;
    if gas=0 then begin ok:=0;break;end;
   end;
  if ok=1 then
           if p-aa+1<min then begin min:=p-aa+1;h:=1;end;
 end;
if h=1 then writeln(f2,min)
else writeln(f2,-1);
close(f1);
close(f2);
end.