Cod sursa(job #203674)

Utilizator GavrilaVladGavrila Vlad GavrilaVlad Data 18 august 2008 13:58:12
Problema Subsir 2 Scor 64
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.69 kb
var v,l,u:array[1..5000]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);
   for i:=n downto 1 do
   begin
   m:=1000001;
   p:=5001;
   o:=1000001;
   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=5001 then begin l[i]:=1;
                        u[i]:=i;
                  end
             else begin l[i]:=p+1;
                        u[i]:=r;
                  end;
   end;
   j:=0;
   p:=5001;
   m:=1000001;
   for i:=1 to n do
   if(v[i]<m)then begin if(l[i]<p)then begin r:=i;
                                             p:=l[i];
                                             o:=v[i];
                                       end
                                  else
                        if(l[i]=p)and(o>v[i])then begin r:=i;
                                                        o:=v[i];
                                                  end;
                        m:=v[i];
                  end;
   assign(f,'subsir2.out');
   rewrite(f);
   writeln(f,p);
   for i:=1 to p do
   begin
   write(f,r,' ');
   r:=u[r];
   end;
   writeln(f);
   close(f);
end.