Cod sursa(job #1099161)

Utilizator DjokValeriu Motroi Djok Data 5 februarie 2014 16:52:27
Problema Secv Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.64 kb
var a,b:array[1..5009] of longint;
    i,j,n,k,k1,k3,k2,max:longint;
    u,y:byte;

  procedure swap(var x,y:longint);
      var aux:longint;
       begin
        aux:=x;
        x:=y;
        y:=aux;
       end;

     procedure qsort(left,right:longint);
       var i,j,pivot:longint;
        begin
          i:=left; j:=right; pivot:=a[(left+right) div 2];
             repeat
              while a[i]<pivot do inc(i);
              while a[j]>pivot do dec(j);
               if i<=j then begin
                             swap(a[i],a[j]);
                             inc(i);
                             dec(j);
                            end;
             until i>j;
           if j>left then qsort(left,j);
           if i<right then qsort(i,right);
        end;


begin
assign(input,'secv.in');
assign(output,'secv.out');
reset(input);
rewrite(output);
  readln(n);
   for i:=1 to n do
    begin
     read(a[i]);
     b[i]:=a[i];
    end;

    qsort(1,n);
     for i:=1 to n do
      if b[i]=a[1] then if k=0 then k:=i;

      max:=5001; j:=1;
      while a[j]=a[1] do
       begin
        u:=1; k1:=k; k2:=k1; k:=0;
         if k1<>0 then for i:=j+1 to n do
                         if a[i]<>a[i-1] then begin
                                               k3:=k2;
                                                while (k3<n) and (b[k3]<>a[i]) do begin
                                                                                   inc(k3);
                                                                                   if b[k3]=a[1] then  if k=0 then k:=k3;
                                                                                  end;
                                                if a[i]=b[k3] then k2:=k3
                                                              else u:=0;
                                              end;

                         if k=0 then begin
                                      k:=k2;
                                      while (b[k]<>a[1]) and (k<n) do
                                       inc(k);
                                     end;
                         if u=1 then begin
                                      if max>k2-k1 then begin
                                                         max:=k2-k1;
                                                         y:=1;
                                                        end;
                                     end;



         inc(j);
       end;

      if y=1 then writeln(max+1)
             else writeln('-1');



close(input);
close(output);
{Totusi este trist in lume}
end.