Cod sursa(job #268218)

Utilizator MihaiBunBunget Mihai MihaiBun Data 28 februarie 2009 22:24:40
Problema Secv Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.74 kb
program jiji;
type vector=array[1..5000] of longint;
var f:text;
    a,b,d,t:vector;
    i,n,k,min,max,j,m,s:longint;

procedure poz(li,ls:longint;var k:longint;var b:vector);
var p,q,c,p1,q1:longint;
begin
   p1:=0;
   q1:=-1;
   p:=li;
   q:=ls;
   while p<q do
     begin
       if b[p]>b[q] then begin
                           c:=b[p];
                           b[p]:=b[q];
                           b[q]:=c;
                           c:=p1;
                           p1:=-q1;
                           q1:=-c
                         end;
       p:=p+p1;
       q:=q+q1;
     end;
    k:=p;
  end;

  procedure quick(li,ls:longint);
  begin
    if li<ls then begin
                     poz(li,ls,k,b);
                     quick(li,k-1);
                     quick(k+1,ls)
                  end;
  end;

begin
  assign(f,'secv.in');
  reset(f);
  readln(f,n);
  for i:=1 to n do begin
                     read(f,a[i]);
                     b[i]:=a[i]
                   end;
  close(f);
  assign(f,'secv.out');
  rewrite(f);
  quick(1,n);
  m:=1;
  min:=10000;
  for i:=2 to n do
    if b[i]<>b[i-1] then m:=m+1;
  d[1]:=1;
  for i:=2 to n do
    begin
      max:=0;
      for j:=1 to i-1 do
        if a[j]<a[i] then if d[j]>=max then begin
                                            max:=d[j];
                                            t[i]:=j;
                                            end;

      d[i]:=max+1;
      if d[i]=m then begin
                      s:=i;
                      for j:=m-1 downto 1 do s:=t[s];
                      if (i-s+1)<min then min:=i-s+1
                     end;
    end;
  if min=10000 then write(f,-1)
               else write(f,min);
 close(f);

end.