Cod sursa(job #136401)

Utilizator you_reheroMihai Gojinetchi you_rehero Data 15 februarie 2008 15:30:00
Problema Secv Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.62 kb
var fi,fo:text;
    n,i,j,ct,min,dist,k,poz,ok:integer;
    nr,x,s:array[1..5000]of longint;
function part(st,dr:integer):integer;
var i,j,s:integer;
    aux:longint;
begin
  i:=st; j:=dr; s:=-1;
  while i<j do
    begin
      if nr[i]>nr[j] then
        begin
          aux:=nr[i];
          nr[i]:=nr[j];
          nr[j]:=aux;
          s:=-s;
        end;
      if s=1 then inc(i)
             else dec(j);
    end;
  part:=i;
end;
procedure qsort(st,dr:integer);
var p:integer;
begin
  if st<dr then
    begin
      p:=part(st,dr);
      qsort(st,p-1);
      qsort(p+1,dr);
    end;
end;
begin
  assign(fi,'secv.in'); reset(fi);
  assign(fo,'secv.out'); rewrite(fo);
  read(fi,n);
  for i:=1 to n do
    begin
      read(fi,nr[i]);
      s[i]:=nr[i];
    end;
  qsort(1,n);
  ct:=1;
  x[ct]:=nr[1];
  for i:=2 to n do
    if nr[i]<>nr[i-1] then
      begin
        inc(ct);
        x[ct]:=nr[i];
      end;
  min:=maxint;
  for i:=1 to n do
    if s[i]=x[1] then
      begin
        poz:=i;
        ok:=1;
        for j:=2 to ct do
          if ok=1 then
            begin
              for k:=poz+1 to n do
                if s[k]=x[j] then
                  begin
                    poz:=k;
                    ok:=1;
                    break;
                  end
                else
                  ok:=0;
            end;
        if ok=1 then
          begin
            dist:=poz-i+1;
            if min>dist then min:=dist;
          end;
      end;
  if min<>maxint then writeln(fo,min)
                 else writeln(fo,-1);
  close(fi);
  close(fo);
end.