var f:array[1..1000,1..2]of integer;
m:array[1..1000]of integer;
n:integer;
procedure task1;
var
i,j,max:integer;
begin
for i:=1 to n do begin f[i,1]:=1; f[i,2]:=0; end;
for i:=n-1 downto 1 do
for j:=i+1 to n do
if (m[i]>=m[j])and (f[i,1]<f[j,1]+1) then
begin f[i,1]:=f[j,1]+1; f[i,2]:=j; end;
max:=0;
for i:=1 to n do if f[i,1]>max then begin max:=f[i,1]; j:=i; end;
writeln(max,' ');
end;
procedure task2;
var t,k,i,j,kk,max:integer;
begin
t:=0; k:=0;
while k<n do
begin
j:=1;
while j<=n do
begin
max:=m[j]; kk:=j;
for i:=j to n do
if m[i]>max then begin kk:=i; max:=m[i]; end;
if m[kk]<>0 then begin k:=k+1; m[kk]:=0; end;
j:=kk+1;
end;
t:=t+1;
end;
write(t);
end;
begin n:=0; repeat inc(n); read(m[n]); until eoln;
task1; task2;
end.
同感。。。
var
t,i,j,n,m,w,q:integer;
a,b,c,d:array[0..10000]of integer;
begin
n:=0;
while not eoln do
begin
inc(n);
read(a[n]);
end;
q:=1;
repeat
m:=0;
fillchar(d,sizeof(a),0);
fillchar(b,sizeof(b),0);
fillchar(c,sizeof(c),0);
for i:=1 to n do
begin
t:=1;
while a[i]<=b[t] do
inc(t);
b[t]:=a[i];
if t>m then m:=t;
d[t]:=i;
c[i]:=d[t-1];
end;
if q=1 then
begin
q:=0;
writeln(m);
end;
a[d[m]]:=0;
t:=d[m];
while t>0 do
begin
a[c[t]]:=0;
t:=c[t];
end;
j:=0;
fillchar(d,sizeof(d),0);
for i:=1 to n do
if a[i]<>0 then
begin
inc(j);
d[j]:=a[i];
end;
n:=j;
inc(w);
a:=d;
until n=0;
writeln(w);
end.