Cod sursa(job #268494)

Utilizator valytgjiu91stancu vlad valytgjiu91 Data 1 martie 2009 12:38:21
Problema Subsir 2 Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.15 kb
var  
   p1,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);
     min:=1000000;
     for i:=1 to n do
         begin
         read(f,a[i]);
         if min>a[i] then begin min:=a[i]; p1:=i end;
         end;
     close(f);
     L[n]:=1;
     poz[n]:=-1;
     for i:=n-1 downto p1 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.