Cod sursa(job #203680)

Utilizator GavrilaVladGavrila Vlad GavrilaVlad Data 18 august 2008 14:45:45
Problema Subsir 2 Scor 64
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.31 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:=1000000001;
   l[i]:=600002;
   o:=1000000001;
   for j:=i+1 to n do
   if(m>=v[j])and(v[j]>=v[i])then begin if(l[j]<l[i])then begin l[i]:=l[j];
                                                                o:=v[j];
                                                                u[i]:=j;
                                                          end
                                                     else
                                        if(l[j]=l[i])and(v[j]<=o)then begin o:=v[j];
                                                                            u[i]:=j;
                                                                      end;
                                        m:=v[j];
                                  end;
   if l[i]=600002 then begin l[i]:=0;
                             u[i]:=i;
                       end;
   l[i]:=l[i]+1;
   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.