Cod sursa(job #598829)

Utilizator tibi9876Marin Tiberiu tibi9876 Data 27 iunie 2011 12:14:05
Problema Secv Scor 70
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.91 kb
var a,b:array[1..5000] of longint;
    ok:boolean;
    i,k,p,j,n,aux,min:longint;


procedure Sort(l, r: Integer);
var i,j,x,y: integer;
begin
i := l; j := r; x := b[(l+r) DIV 2];
repeat
while b[i] < x do i := i + 1;
while x < b[j] do j := j - 1;
if i <= j then
begin
y := b[i]; b[i] := b[j]; b[j] := y;
i := i + 1; j := j - 1;
end;
until i > j;
if l < j then Sort(l, j);
if i < r then Sort(i, r);
end;


begin
assign(input,'secv.in');reset(input);
assign(output,'secv.out');rewrite(output);
readln(n);
for i:=1 to n do read(a[i]);
b:=a;
sort(1,n);
k:=1;
for i:=2 to n do
if b[i]<>b[k] then
begin
inc(k);
b[k]:=b[i];
end;
min:=maxlongint;
for i:=1 to n do
if a[i]=b[1] then
begin
p:=2;j:=i+1;
while (p<=k) and (j<=n) do
begin
if a[j]=b[p] then inc(p);
inc(j);
end;
if (p=k+1) and (j-i<min) then min:=j-i;
end;
if min<>maxlongint then writeln(min) else writeln(-1);
end.