Cod sursa(job #203677)

Utilizator GavrilaVladGavrila Vlad GavrilaVlad Data 18 august 2008 14:32:31
Problema Subsir 2 Scor 64
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.33 kb
var v,l,u:array[0..5010]of longint;
    n,i,j,k,m,p,o,r:longint;
    f:text;
begin
   assign(f,'subsir2.in');
   reset(f);
   read(f,n);
   for i:=1 to n do
   read(f,v[i]);
   close(f);
   v[0]:=-10000001;
   for i:=n downto 0 do
   begin
   m:=10000001;
   p:=6002;
   o:=10000001;
   for j:=i+1 to n do
   if(m>=v[j])and(v[j]>=v[i])then begin if(l[j]<p)then begin p:=l[j];
                                                             o:=v[j];
                                                             r:=j;
                                                       end
                                                  else
                                        if(l[j]=p)and(v[j]<o)then begin o:=v[j];
                                                                        r:=j;
                                                                  end;
                                        m:=v[j];
                                  end;
   if p=6002 then begin l[i]:=1;
                        u[i]:=i;
                  end
             else begin l[i]:=p+1;
                        u[i]:=r;
                  end;
   end;
   assign(f,'subsir2.out');
   rewrite(f);
   writeln(f,l[0]-1);
   r:=u[0];
   for i:=1 to l[0]-1 do
   begin
   write(f,r,' ');
   r:=u[r];
   end;
   writeln(f);
   close(f);
end.