Cod sursa(job #355438)

Utilizator cremarencodianaCremarenco Diana cremarencodiana Data 11 octombrie 2009 09:53:13
Problema Subsir 2 Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.72 kb
var a,l:array[1..5000] of integer;
n,i,j,k,max,r,p:integer;
begin
assign(input,'subsir2.in'); reset(input);
assign(output,'subsir2.out'); rewrite(output);
readln(n);
for i:=1 to n do readln(a[i]);
l[n]:=1;
for i:=n-1 downto 1 do begin
 max:=0;
 for j:=i+1 to n do
  if (a[i]<a[j]) and (l[j]>max) then max:=l[j];
 l[i]:=1+max;
 end;
max:=0;
for i:=1 to n do
 if (l[i]>max) then begin max:=l[i]; p:=i; end
  else
  if l[i]=max then
   if a[p]>a[i] then begin max:=l[i]; p:=i; end;
writeln(max);

while max>0 do begin
 write(p,' ');
 dec(max);
 for i:=p+1 to n do
  if (a[p]<a[i]) and (l[i]=max) then r:=i;
 for i:=p+1 to n do
  if (l[i]=max) and (a[i]<a[r]) then r:=i;
 p:=r;
 end;
close(output);
end.