Cod sursa(job #63801)

Utilizator cevanu se spune ceva Data 31 mai 2007 08:07:15
Problema Secv Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.12 kb
var n,m,rez,i,j,k,x:longint;
    v,t,c:array[1..5000] of longint;
    f,g:text;
procedure pozitie(var m:longint; p,u:longint);
var i,j,di,dj,aux:longint;
begin
di:=0;
dj:=-1;
i:=p;
j:=u;
while i<j do begin
if t[i]>t[j] then
begin
aux:=di;
di:=-dj;
dj:=-aux;
aux:=t[i];
t[i]:=t[j];
t[j]:=aux;
end;
i:=i+di;
j:=j+dj;
end;
m:=i;
end;
procedure quick(p,u:longint);
var m:longint;
begin
if p<u then begin
pozitie(m,p,u);
quick(p,m-1);
quick(m+1,u);
end;
end;
begin
 assign(f,'secv.in'); reset(f);
 assign(g,'secv.out'); rewrite(g);
 readln(f,n);
 rez:=1000000000;
 for i:=1 to n do begin
  read(f,v[i]);
  t[i]:=v[i];
 end;
 quick(1,n);
 c[1]:=t[1];
 m:=1;
 for i:=2 to n do
  if t[i]<>t[i-1] then begin
   inc(m);
   c[m]:=t[i];
  end;
 for i:=n downto 1 do begin
  if v[i]=c[m] then begin
   k:=i;
   for j:=m-1 downto 1 do begin
    while (j>0) and (k>0) and (v[k]<>c[j]) do
     dec(k);
    if k<0 then
     break;
   end;
   if (k>0) and (rez>i-k+1) then
    rez:=i-k+1;
  end;
 end;
 if rez=1000000000 then
  writeln(g,'-1')
 else
  writeln(g,rez);
 close(f); close(g);
end.