Cod sursa(job #250812)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 31 ianuarie 2009 21:57:49
Problema Secv Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.95 kb
program alex;
var  f:text;
     a,lung,c:array[1..5001]of longint;
     i,n,max,j,d,min:longint;
begin
assign(f,'secv.in');reset(f);
readln(f,n);
for i:=1 to n do
    read(f,a[i]);
lung[1]:=1;
max:=0;
for i:=2 to n do
    begin
    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);
min:=10000;
for i:=1 to n do
    begin
    if lung[i]=max then begin
                        d:=1;
                        j:=c[i];
                        repeat
                        d:=d+1;
                        j:=c[j];
                        until(d=max-1);
                        if i-j<min then min:=i-j;
                        end;
    end;
assign(f,'secv.out');rewrite(f);
writeln(f,min);
close(f);
end.