Cod sursa(job #250823)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 31 ianuarie 2009 22:28:34
Problema Secv Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.52 kb
program alex;
var  f:text;
     a,lung,c,b:array[1..2001]of longint;
     i,n,max,j,d,min,x,k:longint;
     e:boolean;
begin
assign(f,'secv.in');reset(f);
readln(f,n);
for i:=1 to n do
    read(f,a[i]);
lung[1]:=1;
for i:=2 to n do
    begin
    max:=0;
    for j:=i-1 downto 1 do
        if a[i]>a[j] then if lung[j]>max then begin
                                              max:=lung[j];
                                              c[i]:=j;
                                              end;
    lung[i]:=max+1;
    end;
close(f);
max:=0;
for i:=1 to n do
    if lung[i]>max then begin
                        max:=lung[i];
                        x:=i;
                        end;
min:=10000;
b[max]:=a[x];
for i:=max-1 downto 1 do
    begin
    b[i]:=a[c[x]];
    x:=c[x];
    end;
i:=0;
e:=false;
repeat
i:=i+1;
for j:=1 to max do
    if a[i]=b[j] then begin
                       e:=true;
                       break;
                       end;
until(i=n)or(e=false);
assign(f,'secv.out');rewrite(f);
if e=false then write(f,-1)
           else begin
for i:=1 to n do
    if a[i]=b[1] then begin
                      x:=i;
                      j:=i;
                      k:=2;
                      repeat
                      j:=j+1;
                      if a[j]=b[k] then k:=k+1;
                      until(j=n)or(k=max+1);
                      if k=max+1 then if j-x+1<min then min:=j-x+1;
                      end;

writeln(f,min);
               end;
close(f);
end.