Cod sursa(job #301212)

Utilizator cristinabCristina Brinza cristinab Data 8 aprilie 2009 00:03:14
Problema Secv Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.39 kb
var v,copie,c:array[1..5000] of longint;
    n,m,rez:integer;

procedure citire;
var f:text;
    i:integer;
begin
assign(f,'secv.in'); reset(f);
readln(f,n);
for i:=1 to n do read(f,v[i]);
copie:=v;
close(f);
end;

procedure qsort(l,r:integer);
var i,j:integer;
    x,aux:longint;
begin
i:=l;
j:=r;
x:=copie[(l+r) div 2];

repeat
  while (copie[i]<x) do inc(i);
  while (copie[j]>x) do dec(j);

  if i<=j then
     begin
     aux:=copie[i];
     copie[i]:=copie[j];
     copie[j]:=aux;
     inc(i);
     dec(j);
     end;

until i>=j;

if j>l then qsort(l,j);
if i<r then qsort(i,r);
end;

procedure construire;
var i:integer;
begin
c[1]:=copie[1];
m:=1;

for i:=2 to n do
    if copie[i]<>copie[i-1] then
       begin
       inc(m);
       c[m]:=copie[i];
       end;
end;

procedure rezolvare;
var i,j,k:integer;
begin
rez:=maxint;
for i:=n downto 1 do
    if v[i]=c[m] then
       begin
       k:=i;
       for j:=m-1 downto 1 do
           begin
           while (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;

procedure afisare;
var g:text;
begin
assign(g,'secv.out'); rewrite(g);
if rez<>maxint then writeln(g,rez)
                   else writeln(g,-1);
close(g);
end;

begin
citire;
qsort(1,n);
construire;
rezolvare;
afisare;
end.