Cod sursa(job #268409)

Utilizator valytgjiu91stancu vlad valytgjiu91 Data 1 martie 2009 11:25:04
Problema Subsir 2 Scor 36
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.04 kb
var  
   min,i,j,n,max,p:longint;
   f:text;
   poz,a,l:array[1..5000] of longint;
Begin
     assign(f,'subsir2.in');
     reset(f);
     readln(f,n);
     for i:=1 to n do
         read(f,a[i]);
     close(f);
     L[n]:=1;
     poz[n]:=-1;
     for i:=n-1 downto 1 do
     begin
          L[i]:=1;
          poz[i]:=-1;
          min:=1000000;
          for j:=i+1 to n do
            if (a[j]<min)and(a[i]<=a[j]) and (L[i]<=1+L[j]) then
                          begin
                               if a[j]<min then min:=a[j];
                               L[i]:=1+L[j];
                               poz[i]:=j;
                          end;
     end;
    max:=L[1];p:=1;
     for i:=2 to n do
         if max<L[i] then begin
                               max:=L[i];
                               p:=i;
                          end;
     assign(f,'subsir2.out'); rewrite(f);
     writeln(f,max);
     i:=p;
     while i<>-1 do
     begin
          write(f,i,' ');
          i:=poz[i];
     end;
     close(f);
End.