program daodan;

var

a,b,h:array[1..20] of longint;

i,j,m,n,x:integer;

begin

repeat

inc(i);

read(a[i]);

for j:= 1 to i-1 do

if a[j]>=a[i] then

if b[j]>b[i] then b[i]:=b[j];

inc(b[i]);

if b[i]>m then m:=b[i];

x:=0;

for j:=1 to n do

if h[j]>=a[i] then

if x=0 then x:=j

else if h[j]

while ( ) do

begin

while ( ) and ( ) do

begin

aa[j]:=( );

i:=i+1;

end;

( );

j:=j+1;

end;

偏序集的Dilworth定理

昨天刚刚作为测试题目考

太爽了

在那基础上改下就AC了

不过我的程序有很大漏洞

我已经找到了作反例的数据

不过既然AC了就不管了

大家试试这个数据：

6,5,1,7,3,2

哈，明白为啥-1了，是求“添加”几套系统……

怎么没有一个人用记录类型？

program jj;

var

s:string;

x,o,i,j,max,n,ans:longint;

a,b:array[0..200] of longint;

f:array[0..200] of boolean;

procedure run(x:longint);

var

i:longint;

begin

for i:=x+1 to o do

if not f[i] and (a[i]max then max:=b[i];

ans:=0;

for i:=1 to o do

begin

if not f[i] then

begin

f[i]:=true;

run(i);

inc(ans);

end;

end;

writeln(max,',',ans-1);

end.

65行

两星纪念！

{————————————————————}

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

---|---|---|---|---|---|---|---|-

Accepted 有效得分：100 有效耗时：0ms

var

st :string;

a,list :array[0..100]of integer;

s,i,j,k,l,r,p :integer;

vis :array[0..100]of boolean;

procedure qiu;

begin

list[1]:=1;

k:=1;

for i:=2 to s do

if a[i]list[j] then

begin

vis[list[i]]:=true;

j:=i;

end;

inc(p);

j:=0;

for i:=1 to s do

if not vis[i] then

begin

inc(j);

a[j]:=a[i];

end;

s:=j;

if s=0 then break;

qiu;

end;

writeln(p-1);

end.

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

---|---|---|---|---|---|---|---|-

Accepted 有效得分：100 有效耗时：0ms

var

a,d,f:array[1..20] of integer;

i,nn,j,n,s3,s,x:integer;

s1,s2:string;

function check:boolean;

var

i:integer;

begin

check:=true;

for i:=1 to n do

if a[i]0 then check:=false;

end;

procedure cut;

var

i,s,s1,st:integer;

begin

s:=0;

for i:=1 to n do

if f[i]>s then begin

s:=f[i];

s1:=i;

end;

st:=d[s1];

a[s1]:=0;

while st0 do

begin

a[st]:=0;

st:=d[st];

end;

end;

procedure try;

var

i,j,s:integer;

begin

fillchar(f,sizeof(f),0);

fillchar(d,sizeof(d),0);

for i:=n downto 1 do

if a[i]0 then break

else n:=n-1;

f[n]:=1;

for i:=n-1 downto 1 do

if a[i]0 then begin

s:=0;

for j:=i+1 to n do

if (a[j]0) and (a[j]s) or ((f[j]>=s) and (s=0)))

then begin

s:=f[j];

d[i]:=j;

end;

f[i]:=s+1;

end;

inc(x);

if nn=0 then

begin

s:=0;

for i:=1 to n do

if f[i]>s then s:=f[i];

write(s);

nn:=1;

end;

cut;

if check then exit

else try;

end;

begin

x:=0; nn:=0;

fillchar(d,sizeof(d),0);

fillchar(f,sizeof(f),0);

assign(input,'stopfire.in');

assign(output,'stopfire.out');

reset(input);

rewrite(output);

readln(s1);

for i:=1 to length(s1) do

begin

if s1[i]',' then s2:=s2+s1[i]

else begin

inc(n);

val(s2,s3);

a[n]:=s3;

s2:='';

end;

if i=length(s1) then begin

inc(n);

val(s2,s3);

a[n]:=s3;

end;

end;

try;

writeln(',',x-1);

close(input);

close(output);

end.

但是

各位同志

注意啦！！！！！！！！！！！！！！！！！！！！

这题数据很有问题,如果是6,5,1,7,3,2 按上面做是2，但其实是1

可是我居然AC了

VIJOS的数据很弱的 哈哈

不过正确来说是这样做的

译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

---|---|---|---|---|---|---|---|-

Accepted 有效得分：100 有效耗时：0ms

var

a,d,f:array[1..20] of integer;

i,nn,j,n,s3,s,x:integer;

s1,s2:string;

procedure try;

var

i,j,s:integer;

begin

fillchar(f,sizeof(f),0);

fillchar(d,sizeof(d),0);

for i:=n downto 1 do

if a[i]0 then break

else n:=n-1;

f[n]:=1;

for i:=n-1 downto 1 do

if a[i]0 then begin

s:=0;

for j:=i+1 to n do

if (a[j]0) and (a[j]s) or ((f[j]>=s) and (s=0)))

then begin

s:=f[j];

d[i]:=j;

end;

f[i]:=s+1;

end;

s:=0;

for i:=1 to n do

if f[i]>s then s:=f[i];

write(s);

end;

begin

x:=0;

fillchar(d,sizeof(d),0);

fillchar(f,sizeof(f),0);

assign(input,'stopfire.in');

assign(output,'stopfire.out');

reset(input);

rewrite(output);

readln(s1);

for i:=1 to length(s1) do

begin

if s1[i]',' then s2:=s2+s1[i]

else begin

inc(n);

val(s2,s3);

a[n]:=s3;

s2:='';

end;

if i=length(s1) then begin

inc(n);

val(s2,s3);

a[n]:=s3;

end;

end;

try;

fillchar(f,sizeof(f),0);

f[n]:=1;

for i:=n-1 downto 1 do

if a[i]0 then begin

s:=0;

for j:=i+1 to n do

if (a[j]0) and (a[j]>a[i]) and ((f[j]>s) or ((f[j]>=s) and (s=0)))

then begin

s:=f[j];

d[i]:=j;

end;

f[i]:=s+1;

end;

s:=0;

for i:=1 to n do

if f[i]>s then s:=f[i];

write(',',s-1);

close(input);

close(output);

end.

var

i,j,k,step,step1,step2,lens,size,jilu,temp,score,answer,answer1,answer2:longint;

q,a,ai,s:array[0..100]of longint;

b:array[0..50]of boolean;

st:ansistring;

flag:boolean;

ans:array[0..50]of longint;

//======================================

procedure init;

begin

readln(st);

step:=0;

answer1:=-1;

fillchar(b,sizeof(b),true);

step1:=1;

lens:=length(st);

for i:=1 to lens do

if st[i]=','

then begin

inc(step);

val(copy(st,step1,i-step1),temp);

a[step]:=temp;

step1:=i+1;

end;

inc(step);

val(copy(st,step1,i-step),temp);

a[step]:=temp;

jilu:=0;

flag:=false;

step1:=0;

end;

//======================================

procedure solve;

begin

s[0]:=0;

answer2:=0;

for i:=1 to step do

begin

s[i]:=0;

for k:=0 to i-1 do

if b[i] and b[k] then

if ((k=0)or(a[k]>a[i]))and(s[k]+1>s[i])

then begin

s[i]:=s[k]+1;

ans[i]:=k;

end;

end;

for i:=1 to step do

if (s[i]>answer2)

then begin

answer2:=s[i];

k:=i;

end;

size:=0;

inc(answer1);

repeat

inc(size);

q:=k;

k:=ans[k];

until k=0;

for i:=1 to size do

b[q[i]]:=false;

for i:=1 to step do

jilu:=jilu+ord(b[i]);

if jilu=0

then begin

flag:=true;

exit;

end;

end;

//======================================

procedure solve1;

begin

s[0]:=0;

answer:=0;

for i:=1 to step do

begin

s[i]:=0;

for k:=0 to i-1 do

if b[i] and b[k] then

if ((k=0)or(a[k]>a[i]))and(s[k]+1>s[i])

then begin

s[i]:=s[k]+1;

ans[i]:=k;

end;

end;

for i:=1 to step do

if (s[i]>answer)

then begin

answer:=s[i];

k:=i;

end;

size:=0;

inc(answer1);

repeat

inc(size);

q:=k;

k:=ans[k];

until k=0;

for i:=1 to size do

b[q[i]]:=false;

jilu:=0;

for i:=1 to step do

jilu:=jilu+ord(b[i]);

if jilu=0

then begin

flag:=true;

exit;

end;

end;

//======================================

begin

init;

solve;

if flag

then begin

writeln(answer2,',',answer1);

halt;

end;

repeat

fillchar(ans,sizeof(ans),0);

solve1;

until (flag)or(step=0);

writeln(answer2,',',answer1);

end.

第二问当然要贪心了

program p1303;

var

s,s1:string;

i,j,k,p,n,x:integer;

l,a,c:array[1..20]of integer;

b:array[1..100]of integer;

begin

read(s);

s:=' '+s;

while s[1]=' ' do

begin

p:=pos(' ',s);

s1:=copy(s,2,p);

delete(s,1,p);

for i:=1 to length(s1) do

a[j]:=a[j]*10+ord(s[i])-48;

n:=n+1;

end;

for i:=1 to n do

b[i]:=1;

for i:=1 to n do

begin

for k:=1 to n do

c[k]:=a[k];

for j:=i to n do

if c[i]>c[j] then

begin

c[i]:=c[j];

b[i]:=b[i]+1;

end;

if b[i]>x then

begin

x:=b[i];

b[i]:=1;

end;

end;

write(x,',');

k:=1;

l[1]:=a[1];

for i:=2 to n do

begin

p:=0;

for j:=1 to k do

if (l[j]>=a[i]) and ((p=0) or (l[j]

读入读错了。。怎么检查都发现不了算法的错误

program P1303;

var a,b,h:array[1..200] of longint;j1,i,j,m,n,x,code:longint;

var st:string;

begin

readln(st);i:=0;

repeat

inc(i);

val(st,a[i],j1);

if j10 then

val(copy(st,1,j1-1),a[i],code);

st:=copy(st,j1+1,255);

for j:=1 to i-1 do

if a[j]>=a[i] then

if b[j]>b[i] then b[i]:=b[j];

inc(b[i]);

if b[i]>m then m:=b[i];

x:=0;

for j:=1 to n do

if h[j]>=a[i] then

if x=0 then begin x:=j;h[x]:=a[i];end

else if h[j]

program vp1303;

var st,s:string;

p,i,j,best,max,n,code:integer;

a,f:array[0..30] of integer;

begin

readln(st);

n:=0;

while st'' do

begin

p:=pos(',',st);

if p=0 then

begin

n:=n+1;

val(st,a[n],code);

st:='';

break;

end;

s:=copy(st,1,p-1);

n:=n+1;

val(s,a[n],code);

delete(st,1,p);

end;

for i:=1 to n do f[i]:=1;

for i:=n-1 downto 1 do

for j:=i+1 to n do

if (a[i]>=a[j])and(f[j]+1>f[i]) then

f[i]:=f[j]+1;

best:=0;

for i:=1 to n do

if f[i]>best then best:=f[i];

write(best,',');

for i:=1 to n do f[i]:=1;

for i:=n-1 downto 1 do

for j:=i+1 to n do

if (a[i]f[i]) then

f[i]:=f[j]+1;

best:=0;

for i:=1 to n do

if f[i]>best then best:=f[i];

write(best-1);

end.

program bomb;

var

s:ansistring;

a,b:array[0..30]of longint;

n,m:longint;

procedure init;

var

i,j:longint;

begin

readln(s);

j:=0;

while s'' do

begin

inc(j);

i:=pos(',',s);

if i0 then val(copy(s,1,i-1),a[j])

else begin val(s,a[j]);i:=30000; end;

delete(s,1,i);

end;

n:=j;

end;

function find(s,t,i:longint):longint;

var

m:longint;

begin

m:=(s+t)div 2;

if (m=s)or(m=t) then exit(s);

if b[m]>a[i] then t:=m else s:=m;

exit(find(s,t,i));

end;

procedure task1;

var

i,len,xx:longint;

begin

b[1]:=a[n];

len:=1;

for i:=n-1 downto 1 do

if b[len]a[i] then b[xx]:=a[i]

else b[xx+1]:=a[i];

end;

write(len,',');

end;

procedure task2;

var

i,j,total,xx:longint;

flag:array[0..30]of boolean;

begin

fillchar(flag,sizeof(flag),false);

m:=0;

flag[1]:=true;

total:=1;

for i:=1 to n do

begin

if (flag[i])and(i1) then continue;

if not flag[i] then begin flag[i]:=true;inc(m);inc(total)end;

xx:=a[i];

if flag[i] then for j:=i+1 to n do

if (not flag[j])and(xx>=a[j])then begin flag[j]:=true;inc(total);xx:=a[j];end;

if total=n then break;

end;

writeln(m);

end;

begin

init;

task1;

task2;

end.

task2简单找法

var

a,b,f:array[1..10000] of longint;

n:longint;

procedure readin;

var

s:string;

i,t,l:longint;

begin

readln(s);

l:=length(s);

t:=1;

for i:=1 to l do

case s[i] of

',':inc(t);

else

a[t]:=a[t]*10+ord(s[i])-48;

end;

n:=t;

end;

procedure find1;

var

i,j:longint;

begin

for i:=1 to n do

b[i]:=1;

for i:=2 to n do

for j:=1 to i-1 do

if (a[j]>=a[i]) and (b[j]>=b[i]) then

b[i]:=b[j]+1;

j:=-1;

for i:=1 to n do

if b[i]>=j then

j:=b[i];

write(j,',');

end;

procedure find2;

var

i,j,t,key,k:longint;

begin

t:=1;

f[1]:=a[1];

for i:=2 to n do

begin

key:=-1;

k:=-1;

for j:=1 to t do

if f[j]>=a[i] then

begin

key:=f[j]-a[i];

k:=j;

end;

if key-1 then

f[k]:=a[i]

else

begin

inc(t);

f[t]:=a[i];

end;

end;

writeln(t-1);

end;

begin

readin;

find1;

find2;

end.

楼下的程序是***|\***|*。

鉴定完毕。

SEVE。

回帖可见隐藏部分。

program daodan;

var

a,f,t:array[0..1000] of longint;

v:array[0..1000] of boolean;

max,i,j,k,m,n,total,ans:longint;

cc:boolean;

s:string;

procedure dp;

begin

for i:=1 to n do if a[i]-1 then f[i]:=1;

for i:=2 to n do

for j:= 1 to i-1 do begin

if (a[j]>=a[i]) and not v[j] and not v[i] and (a[j]-1) then

if f[i]

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案错误...　├ 标准行输出

　├ 错误行输出

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

---|---|---|---|---|---|---|---|-

program ex;

var i,j,l,k,w,n,max,q:integer;

str,x:string;

a,p,f:array[0..30] of integer;

begin

fillchar(f,sizeof(f),0);

i:=0; j:=0;

readln(str);

l:=length(str);

repeat

inc(i);

if str[i]=',' then

begin

inc(j);

x:=copy(str,1,i-1-q);

val(x,a[j]);

delete(str,1,i-q);

q:=i;

end;

until i=l;

val(str,a[j+1]);

n:=j+1;

for i:=1 to 30 do

f[i]:=1;

for i:=n-1 downto 1 do

for j:=i+1 to n do

if (a[j]f[i]) then

f[i]:=f[j]+1;

max:=0;

for i:=1 to n do

if max=a[i]) then

if w=0 then w:=j

else if p[j]