Cod sursa(job #865356)

Utilizator IoanaDanielaRomcea Ioana Daniela IoanaDaniela Data 26 ianuarie 2013 13:13:50
Problema Subsir 2 Scor 45
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.25 kb
var a:array[1..5000] of longint;
    l,p:array[1..5000] of integer;
    n,i,j,max:integer;
    f,g:text;

begin
 assign(f,'subsir2.in');reset(f);
 assign(g,'subsir2.out');rewrite(g);
 readln(f,n);
 for i:=1 to n do
  read(f,a[i]);
 l[n]:=1; p[n]:=0;
 for i:=n-1 downto 1 do
  begin
   l[i]:=0;
   p[i]:=0;
   for j:=i+1 to n  do
    if (a[i]<a[j]) then if (l[j]>l[i]) then
                                        begin
                                         l[i]:=l[j];
                                         p[i]:=j;
                                        end
                                       else if (l[j]=l[i]) and (a[j]<a[p[i]]) then p[i]:=j;
   l[i]:=l[i]+1;
  end;
 max:=0;
 j:=0;
 for i:=1 to n do
  if l[i]>max then begin
                    max:=l[i];
                    j:=i;
                   end
               else if (max=l[i]) and (a[j]>a[i]) then
                                                   begin
                                                    max:=l[i];
                                                    j:=i;
                                                   end;
 writeln(g,max);
 write(g,j,' ');
 while p[j]<>0 do
  begin
   write(g,p[j],' ');
   j:=p[j];
  end;
 close(f);close(g);
end.