Cod sursa(job #46426)

Utilizator raduzerRadu Zernoveanu raduzer Data 2 aprilie 2007 17:17:33
Problema Secv Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.6 kb
var a,b:array[1..5010]of longint;
    n,m,i,j,min,s,t,q,l: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 a[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);
     m:=0;
     for i:=1 to n do
     begin
          read(a[i]);
          q:=0;
          for j:=1 to m do
          begin
               if b[j]=a[i] then
               begin
                    q:=1;
                    break;
               end;
          end;
          if q=0 then
          begin
               inc(m);
               b[m]:=a[i];
          end;
     end;
     sort(1,m);
     j:=1;
     min:=n+1;
     for i:=1 to n do
     begin
          l:=i;
          j:=1;
          s:=1;
          if a[i]=b[1] then
          begin
               j:=j+1;
               while l<n do
               begin
                    if j>m then break;
                    l:=l+1;
                    if a[l]=b[j] then
                    begin
                         j:=j+1;
                         s:=s+1;
                    end;
               end;
               if (s=m)and(l-i+1<min) then min:=l-i+1;
          end;
     end;
     if min=n+1 then min:=-1;
     writeln(min);
close(output);
end.