33,008
社区成员
发帖
与我相关
我的任务
分享SOS! SOS! starfish!请进来一下！：）
这是一道NOI的题目：无根树的枚举。
小弟有一种想法，可以避免判重：排序+生成。
编了半天，还是行不通，望斑竹大侠指点指点！
我的程序如下：
program task3;
type
link=^nodetype;
arr=array[1..25] of link;
nodetype=record
father:link;
sonnum:byte;
dep,num:byte;
son:arr;
adjs:char;
end;
var i,j,k,n,total:integer;
s,f,root1,root2,target:link;
temp:string;
now:longint;
depthchange:boolean;
procedure makebiggest(pn:link; n,d:byte); {done?}
var i:byte; qn:link;
begin
pn^.sonnum:=0;{delete-expect(pn);}
pn^.dep:=d; pn^.num:=n;
if d<>1 then
begin
for i:=d-1 downto 1 do
begin
new(qn); pn^.sonnum:=1; pn^.son[1]:=qn; qn^.father:=pn;
with qn^ do begin dep:=i; num:=n-d+i; end;
pn:=qn;
end;
pn^.sonnum:=0; pn^.num:=1;
pn:=pn^.father; pn^.sonnum:=n-d+1;
for i:=2 to n-d+1 do
begin
new(qn); pn^.son[i]:=qn; qn^.father:=pn;
with qn^ do begin dep:=1; num:=1; end
end;
end;
end;
procedure createtree(root2:link; root1:link); {done?}
var i:byte; s1,s2,f1,f2:link;
begin
f1:=root1; f2:=root2; f2^.sonnum:=f1^.sonnum;
f2^.dep:=f1^.dep; f2^.num:=f1^.num;
for i:=1 to f1^.sonnum do
begin
s1:=f1^.son[i]; new(s2); s2^.father:=f2; f2^.son[i]:=s2;
createtree(s2,s1);
end;
end;
procedure calc(root:link); {done}
var i,d,j:byte; f:link;
begin
if root^.sonnum<>0 then
begin
f:=root; d:=0; f^.num:=1;
for i:=1 to f^.sonnum do
begin
calc(f^.son[i]);
inc(f^.num,f^.son[i]^.num);
if f^.son[i]^.dep>d then begin d:=f^.son[i]^.dep;j:=i end;
end;
f^.dep:=f^.son[j]^.dep+1;
end
else begin root^.dep:=1; root^.num:=1; end;
end;
procedure search(root:link;var target:link); {not done about delete}
begin
s:=root; i:=1;
while i<>0 do
begin
i:=s^.sonnum;
while (i>0)and(s^.sonnum=0) do dec(i);
if i<>0 then s:=s^.son[i];
end;
target:=s^.son[s^.sonnum]; depthchange:=true;
s:=target; f:=s^.father;
while depthchange and (f<>root) do
begin
if s<>f^.son[1] then depthchange:=false;
if depthchange and (f^.sonnum>1) then
begin target:=f^.son[s^.sonnum]; exit end;
s:=f; f:=f^.father;
end;
end;
procedure change(pn:link);
var i:byte;
begin
temp:=temp+pn^.adjs{'P'};
if pn^.sonnum<>0 then
begin
temp:=temp+'(';
for i:=1 to pn^.sonnum do change(pn^.son[i]);
temp:=temp+')';
end;
end;
procedure connect(root1:link; root2:link);
var i:byte;
begin
inc(root1^.sonnum);
root1^.son[root1^.sonnum]:=root2;root2^.father:=root1;
inc(root1^.num,root2^.num);
if root1^.dep<(root2^.dep+1) then root1^.dep:=root2^.dep+1;
change(root1); inc(total);
writeln('NO.',total,' : ',temp);
end;
procedure fit(pn:link; pm:link; sta:byte; add:byte); {done?}
var i,nown,nowd,restn,treen,stan:byte;
qn:link;
begin
restn:=0;
if sta>0 then
for i:=pn^.sonnum downto (sta+1) do
begin inc(restn,pn^.son[i]^.num);dec(pn^.sonnum); end;
inc(restn,add);
stan:=pm^.num; treen:=restn div stan;
for i:=1 to treen do
begin
inc(pn^.sonnum);dec(restn);new(qn);
pn^.son[pn^.sonnum]:=qn; qn^.father:=pn;
createtree(qn,pm);
end;
if (restn mod stan)<>0 then
begin
nown:=restn mod stan; nowd:=pm^.dep;
if nown<nowd then nowd:=nown;
inc(pn^.sonnum); new(qn);
pn^.son[pn^.sonnum]:=qn; qn^.father:=pn;
makebiggest(qn,nown,nowd);
end;
calc(pn);
end;
procedure dnc(target:link; root1:link; root2:link);
var s,f:link;
i,add:byte;
begin
f:=target^.father;
f^.son[f^.sonnum]:=nil; dec(f^.sonnum); dec(f^.num); add:=1;
makebiggest(f,f^.num,f^.dep);
repeat
s:=f; f:=f^.father;
for i:=1 to f^.sonnum do if f^.son[i]=s then break;
fit(f,f^.son[i],i,add);
add:=0;
until f=root1;
end;
procedure dc(target:link; root1:link; root2:link);
var s,f:link;
i,j,n1:byte;
bool:boolean;
begin
f:=target^.father;
{for i:=1 to f^.sonnum do if f^.son[i]=target then break;
f^.son[i]:=nil;dec(f^.sonnum);dec(f^.dep);dec(f^.num);}
f^.son[f^.sonnum]:=nil;dec(f^.sonnum);dec(f^.dep);dec(f^.num);
s:=f; f:=f^.father; bool:=false;
repeat
for i:=1 to f^.sonnum do
if (s^.dep+1)<=f^.son[i]^.dep then begin bool:=true;break;end;
if bool then break;
dec(f^.dep);dec(f^.num); s:=f;f:=f^.father;
until f=root1;
s:=f; f:=s^.father;
for i:=1 to f^.sonnum do if f^.son[i]=s then break;
n1:=0;
for j:=f^.sonnum downto (i+1) do
begin inc(n1,f^.son[j]^.num);dec(f^.sonnum); end;
f^.num:=1; f^.dep:=0;
for i:=1 to f^.sonnum do
begin
inc(f^.num,f^.son[i]^.num);
if f^.dep<f^.son[i]^.dep then f^.dep:=f^.son[i]^.dep;
end;
inc(f^.dep);
makebiggest(s,n1+s^.num,s^.dep);
f:=s;
repeat
s:=f; f:=f^.father;
fit(f,f^.son[i],i,0);
until f=root1;
end;
procedure doublecenter(n:byte);
var sd1,sd2,sn1,sn2:byte;
root1,root2,f,s:link;
begin
for sd1:=2 to n div 2 do
begin
for sn1:=sd1 to n div 2 do
begin
sn2:=n-sn1; sd2:=sd1; new(root1);
makebiggest(root1,sn1,sd1);
repeat
new(root2);
if sn1=sn2 then createtree(root2,root1)
else makebiggest(root2,sn2,sd2);
connect(root1,root2);
while root2^.sonnum<>sn2-sd2+1 do
begin
new(target); search(root2,target);
if depthchange then dc(target,root1,root2)
else dnc(target,root1,root2);
connect(root1,root2);
end;
if root1^.sonnum=sn1-sd1+1 then exit
else begin
new(target); search(root1,target);
if depthchange then dc(target,root1,root2)
else dnc(target,root1,root2);
end;
until false;
end;
end;
end;
procedure singelcenter(n:byte);
var sd1,sd2,sn1,sn2:byte;
root1,root2,f,s:link;
begin
for sd1:=1 to n div 2 do
begin
for sn1:=sd1 to (n-sd1-1) do
begin
if (sd1=1)and(sn1>1) then break;
sn2:=n-sn1; sd2:=sd1+1;
if sn2<sd2 then break;
makebiggest(root1,sn1,sd1);
repeat
fit(root2,root1,0,sn2-1);
connect(root1,root2);
while root2^.sonnum<>sn2-sd2+1 do
begin
new(target); search(root2,target);
if depthchange then dc(target,root1,root2)
else dnc(target,root1,root2);
connect(root1,root2);
end;
if root1^.sonnum=sn1-sd1+1 then exit
else begin
new(target); search(root1,target);
if depthchange then dc(target,root1,root2)
else dnc(target,root1,root2);
end;
until false;
end;
end;
end;
begin {MAIN}
writeln('input n: '); readln(n); inc(n); total:=0;
now:=meml[$40:$6c];
singelcenter(n);
doublecenter(n);
writeln((meml[$40:$6c]-now)/18.2:10:7); writeln; readln;
end.
小弟有一种想法，可以避免判重：排序+生成。
编了半天，还是行不通，望斑竹大侠指点指点！
我的程序如下：
program task3;
type
link=^nodetype;
arr=array[1..25] of link;
nodetype=record
father:link;
sonnum:byte;
dep,num:byte;
son:arr;
adjs:char;
end;
var i,j,k,n,total:integer;
s,f,root1,root2,target:link;
temp:string;
now:longint;
depthchange:boolean;
procedure makebiggest(pn:link; n,d:byte); {done?}
var i:byte; qn:link;
begin
pn^.sonnum:=0;{delete-expect(pn);}
pn^.dep:=d; pn^.num:=n;
if d<>1 then
begin
for i:=d-1 downto 1 do
begin
new(qn); pn^.sonnum:=1; pn^.son[1]:=qn; qn^.father:=pn;
with qn^ do begin dep:=i; num:=n-d+i; end;
pn:=qn;
end;
pn^.sonnum:=0; pn^.num:=1;
pn:=pn^.father; pn^.sonnum:=n-d+1;
for i:=2 to n-d+1 do
begin
new(qn); pn^.son[i]:=qn; qn^.father:=pn;
with qn^ do begin dep:=1; num:=1; end
end;
end;
end;
procedure createtree(root2:link; root1:link); {done?}
var i:byte; s1,s2,f1,f2:link;
begin
f1:=root1; f2:=root2; f2^.sonnum:=f1^.sonnum;
f2^.dep:=f1^.dep; f2^.num:=f1^.num;
for i:=1 to f1^.sonnum do
begin
s1:=f1^.son[i]; new(s2); s2^.father:=f2; f2^.son[i]:=s2;
createtree(s2,s1);
end;
end;
procedure calc(root:link); {done}
var i,d,j:byte; f:link;
begin
if root^.sonnum<>0 then
begin
f:=root; d:=0; f^.num:=1;
for i:=1 to f^.sonnum do
begin
calc(f^.son[i]);
inc(f^.num,f^.son[i]^.num);
if f^.son[i]^.dep>d then begin d:=f^.son[i]^.dep;j:=i end;
end;
f^.dep:=f^.son[j]^.dep+1;
end
else begin root^.dep:=1; root^.num:=1; end;
end;
procedure search(root:link;var target:link); {not done about delete}
begin
s:=root; i:=1;
while i<>0 do
begin
i:=s^.sonnum;
while (i>0)and(s^.sonnum=0) do dec(i);
if i<>0 then s:=s^.son[i];
end;
target:=s^.son[s^.sonnum]; depthchange:=true;
s:=target; f:=s^.father;
while depthchange and (f<>root) do
begin
if s<>f^.son[1] then depthchange:=false;
if depthchange and (f^.sonnum>1) then
begin target:=f^.son[s^.sonnum]; exit end;
s:=f; f:=f^.father;
end;
end;
procedure change(pn:link);
var i:byte;
begin
temp:=temp+pn^.adjs{'P'};
if pn^.sonnum<>0 then
begin
temp:=temp+'(';
for i:=1 to pn^.sonnum do change(pn^.son[i]);
temp:=temp+')';
end;
end;
procedure connect(root1:link; root2:link);
var i:byte;
begin
inc(root1^.sonnum);
root1^.son[root1^.sonnum]:=root2;root2^.father:=root1;
inc(root1^.num,root2^.num);
if root1^.dep<(root2^.dep+1) then root1^.dep:=root2^.dep+1;
change(root1); inc(total);
writeln('NO.',total,' : ',temp);
end;
procedure fit(pn:link; pm:link; sta:byte; add:byte); {done?}
var i,nown,nowd,restn,treen,stan:byte;
qn:link;
begin
restn:=0;
if sta>0 then
for i:=pn^.sonnum downto (sta+1) do
begin inc(restn,pn^.son[i]^.num);dec(pn^.sonnum); end;
inc(restn,add);
stan:=pm^.num; treen:=restn div stan;
for i:=1 to treen do
begin
inc(pn^.sonnum);dec(restn);new(qn);
pn^.son[pn^.sonnum]:=qn; qn^.father:=pn;
createtree(qn,pm);
end;
if (restn mod stan)<>0 then
begin
nown:=restn mod stan; nowd:=pm^.dep;
if nown<nowd then nowd:=nown;
inc(pn^.sonnum); new(qn);
pn^.son[pn^.sonnum]:=qn; qn^.father:=pn;
makebiggest(qn,nown,nowd);
end;
calc(pn);
end;
procedure dnc(target:link; root1:link; root2:link);
var s,f:link;
i,add:byte;
begin
f:=target^.father;
f^.son[f^.sonnum]:=nil; dec(f^.sonnum); dec(f^.num); add:=1;
makebiggest(f,f^.num,f^.dep);
repeat
s:=f; f:=f^.father;
for i:=1 to f^.sonnum do if f^.son[i]=s then break;
fit(f,f^.son[i],i,add);
add:=0;
until f=root1;
end;
procedure dc(target:link; root1:link; root2:link);
var s,f:link;
i,j,n1:byte;
bool:boolean;
begin
f:=target^.father;
{for i:=1 to f^.sonnum do if f^.son[i]=target then break;
f^.son[i]:=nil;dec(f^.sonnum);dec(f^.dep);dec(f^.num);}
f^.son[f^.sonnum]:=nil;dec(f^.sonnum);dec(f^.dep);dec(f^.num);
s:=f; f:=f^.father; bool:=false;
repeat
for i:=1 to f^.sonnum do
if (s^.dep+1)<=f^.son[i]^.dep then begin bool:=true;break;end;
if bool then break;
dec(f^.dep);dec(f^.num); s:=f;f:=f^.father;
until f=root1;
s:=f; f:=s^.father;
for i:=1 to f^.sonnum do if f^.son[i]=s then break;
n1:=0;
for j:=f^.sonnum downto (i+1) do
begin inc(n1,f^.son[j]^.num);dec(f^.sonnum); end;
f^.num:=1; f^.dep:=0;
for i:=1 to f^.sonnum do
begin
inc(f^.num,f^.son[i]^.num);
if f^.dep<f^.son[i]^.dep then f^.dep:=f^.son[i]^.dep;
end;
inc(f^.dep);
makebiggest(s,n1+s^.num,s^.dep);
f:=s;
repeat
s:=f; f:=f^.father;
fit(f,f^.son[i],i,0);
until f=root1;
end;
procedure doublecenter(n:byte);
var sd1,sd2,sn1,sn2:byte;
root1,root2,f,s:link;
begin
for sd1:=2 to n div 2 do
begin
for sn1:=sd1 to n div 2 do
begin
sn2:=n-sn1; sd2:=sd1; new(root1);
makebiggest(root1,sn1,sd1);
repeat
new(root2);
if sn1=sn2 then createtree(root2,root1)
else makebiggest(root2,sn2,sd2);
connect(root1,root2);
while root2^.sonnum<>sn2-sd2+1 do
begin
new(target); search(root2,target);
if depthchange then dc(target,root1,root2)
else dnc(target,root1,root2);
connect(root1,root2);
end;
if root1^.sonnum=sn1-sd1+1 then exit
else begin
new(target); search(root1,target);
if depthchange then dc(target,root1,root2)
else dnc(target,root1,root2);
end;
until false;
end;
end;
end;
procedure singelcenter(n:byte);
var sd1,sd2,sn1,sn2:byte;
root1,root2,f,s:link;
begin
for sd1:=1 to n div 2 do
begin
for sn1:=sd1 to (n-sd1-1) do
begin
if (sd1=1)and(sn1>1) then break;
sn2:=n-sn1; sd2:=sd1+1;
if sn2<sd2 then break;
makebiggest(root1,sn1,sd1);
repeat
fit(root2,root1,0,sn2-1);
connect(root1,root2);
while root2^.sonnum<>sn2-sd2+1 do
begin
new(target); search(root2,target);
if depthchange then dc(target,root1,root2)
else dnc(target,root1,root2);
connect(root1,root2);
end;
if root1^.sonnum=sn1-sd1+1 then exit
else begin
new(target); search(root1,target);
if depthchange then dc(target,root1,root2)
else dnc(target,root1,root2);
end;
until false;
end;
end;
end;
begin {MAIN}
writeln('input n: '); readln(n); inc(n); total:=0;
now:=meml[$40:$6c];
singelcenter(n);
doublecenter(n);
writeln((meml[$40:$6c]-now)/18.2:10:7); writeln; readln;
end.
...全文
请发表友善的回复…
发表回复
newtoon2002 2001-09-02
- 打赏
- 举报
up
up
up
up
up
newtoon2002 2001-08-29
- 打赏
- 举报
up
newtoon2002 2001-08-28
- 打赏
- 举报
对了，我刚刚看了一下，我有很多分！ 答对了，再给80分！
newtoon2002 2001-08-28
- 打赏
- 举报
谢谢你，starfish(海星)
E-mail: newtoon2002@yahoo.com.cn.好记吧！
E-mail: newtoon2002@yahoo.com.cn.好记吧！
Zig 2001-08-28
- 打赏
- 举报
看ly的论文。
newtoon2002 2001-08-28
- 打赏
- 举报
对于一棵树来说，总支数等于节点数-1。
那么，我们就构造一棵树，使之满足条件。构造时，我是采用排序的思想，即从大到小地生成，保证枚举成功。
我们约定，树的大小比较依据是：1.深度大的树大；其次2. 深度相等的节点多的大。
在比较两棵树时，对其中的一棵树进行换根操作，和另外一棵比较。当然在比较时，就用到了排序的结果（方便啊！）。
如果在中间发现2棵树相同，则退出；一直比较到最后，也就是一棵树从最小变到最大，如果不同，则不同构。
当然，在程序中：1.要剪枝同时行前树最大（或最小），这样才不会有遗漏；
2.对于节点是有要求的：2k个节点要用double center；2（k+1）个节点要用singel center.因为做法是有差异的。
3.删除一个点后，有2种操作：树的深度改变的dc(deepth changed);树的深度不改变的dnc(deepth not changed).
4.过程make-biggest是生成最大树用的。
5.过程fit是改变树的结构后，使这棵树最大用的。
6.过程calc是计算每个节点的深度（包括本节点），子树的数目，所有子节点树 用的。
那么，我们就构造一棵树，使之满足条件。构造时，我是采用排序的思想，即从大到小地生成，保证枚举成功。
我们约定，树的大小比较依据是：1.深度大的树大；其次2. 深度相等的节点多的大。
在比较两棵树时，对其中的一棵树进行换根操作，和另外一棵比较。当然在比较时，就用到了排序的结果（方便啊！）。
如果在中间发现2棵树相同，则退出；一直比较到最后，也就是一棵树从最小变到最大，如果不同，则不同构。
当然，在程序中：1.要剪枝同时行前树最大（或最小），这样才不会有遗漏；
2.对于节点是有要求的：2k个节点要用double center；2（k+1）个节点要用singel center.因为做法是有差异的。
3.删除一个点后，有2种操作：树的深度改变的dc(deepth changed);树的深度不改变的dnc(deepth not changed).
4.过程make-biggest是生成最大树用的。
5.过程fit是改变树的结构后，使这棵树最大用的。
6.过程calc是计算每个节点的深度（包括本节点），子树的数目，所有子节点树 用的。
starfish 2001-08-28
- 打赏
- 举报
TO: newtoon2002(油田) 文章我已经发给你了。
zhangshicun 2001-08-27
- 打赏
- 举报
starfish(海星):
我也有事要问你，
http://www.csdn.net/expert/TopicView.asp?id=258221
我也有事要问你，
http://www.csdn.net/expert/TopicView.asp?id=258221
forprograme 2001-08-26
- 打赏
- 举报
把算法说明白点，这多麻烦！！！
starfish 2001-08-26
- 打赏
- 举报
对了，你把email告诉我，我发给你一篇论文，应该对你有帮助的
starfish 2001-08-26
- 打赏
- 举报
先说说你的算法思路好么
这么长的程序如果不知道你的思路看得太麻烦了
这么长的程序如果不知道你的思路看得太麻烦了
newtoon2002 2001-08-26
- 打赏
- 举报
还有，我只能给这么一点分了，55555555，太对不起了，55555555。
newtoon2002 2001-08-26
- 打赏
- 举报
对了，有的procedure后面表了{done}表示我已单独测试过，没问题。
