牛人请进！

newtoon2002 2001-08-26 10:04:46

这也是NOI的题目：无根树的枚举--task2。
我看来看去，好像看不出有错。但是，自从我运行成功后，就再也没有调试成功。
why????
程序如下：
program task2;
type
link=^nodetype;
arr=array[1..15] of link;
nodetype=record
father:link;
sonnum:byte;
dep,num:byte;
son:arr;
adjs:char;
end;
var i,j,k1,k2:byte;
s,f,nroot1,nroot2,root1,root2:link;
str1,str2,st1,st2,temp:string;
now:longint;
f1,f2:text;
procedure creatree(root:link;str:string;k:byte); {done}
begin
root^.adjs:=str[1]; root^.sonnum:=0;
i:=3; f:=root;
while i<=k do
begin
if (str[i]<>'(')and(str[i]<>')') then
begin
new(s); s^.adjs:=str[i];s^.father:=f;s^.sonnum:=0;
inc(f^.sonnum); f^.son[f^.sonnum]:=s;
end;
if str[i]='(' then f:=s;
if str[i]=')' then f:=f^.father;
inc(i);
end;
end;
function search(ch:char;root:link):link; {done}
var i:byte; s:link;
begin
s:=root;
for i:=1 to s^.sonnum do
if s^.son[i]^.adjs=ch then begin search:=s^.son[i];exit end
else search:=search(ch,s^.son[i]);
end;
procedure newtree(ch:char); {done}
begin
new(nroot1); nroot1:=search(ch,root1);
s:=nroot1; f:=nroot1;
inc(s^.sonnum);s^.son[s^.sonnum]:=s^.father;s^.father:=nil;
s:=s^.son[s^.sonnum];
for i:=1 to s^.sonnum do if s^.son[i]=f then break;
s^.son[i]:=nil;
while (s^.son[i+1]<>nil)and(i<=s^.sonnum) do
begin s^.son[i]:=s^.son[i+1];inc(i); end;
dec(s^.sonnum);
while s<>root1 do
begin
inc(s^.sonnum);s^.son[s^.sonnum]:=s^.father;s^.father:=f;
f:=s; s:=s^.son[s^.sonnum];
for i:=1 to s^.sonnum do if s^.son[i]=f then break;
s^.son[i]:=nil;
while (s^.son[i+1]<>nil)and(i<=s^.sonnum) do
begin s^.son[i]:=s^.son[i+1];inc(i); end;
dec(s^.sonnum);
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;
function dpp(s1:link;s2:link):boolean; {done}
var i,j:byte;
begin
for i:=1 to s1^.sonnum do
if s1^.sonnum<>s2^.sonnum then begin dpp:=false;exit end
else
if (s1^.son[i]^.dep<>s2^.son[i]^.dep)or(s1^.son[i]^.num<>s2^.son[i]^.num)
then begin dpp:=false;exit end
else dpp:=dpp(s1^.son[i],s2^.son[i]);
dpp:=true;
end;
procedure paixu(root:link); {done}
var i,ch,m:byte; f,s:link;
begin
f:=root;
for i:=1 to f^.sonnum do
begin
if f^.son[i]^.num>1 then paixu(f^.son[i]);
ch:=f^.sonnum;
while ch>0 do
begin
m:=ch-1; ch:=0;
for j:=1 to m do
if f^.son[j]^.dep<f^.son[j+1]^.dep then
begin
s:=f^.son[j];f^.son[j]:=f^.son[j+1];f^.son[j+1]:=s;ch:=j
end
else if (f^.son[j]^.dep=f^.son[j+1]^.dep)
and(f^.son[j]^.num<f^.son[j+1]^.num) then
begin
s:=f^.son[j];f^.son[j]:=f^.son[j+1];f^.son[j+1]:=s;ch:=j
end;
end;
end;
end;
procedure compare; {done}
begin
paixu(root2);calc(root2); paixu(root1);calc(root1);
if dpp(root1,root2) then begin writeln('They are the same!');exit; end;
for j:=3 to k1 do
if (str1[j]<>'(')and(str1[j]<>')') then
begin
newtree(str1[j]); paixu(nroot1); calc(nroot1); root1:=nroot1;
if dpp(nroot1,root2) then
begin writeln('They are the same!');exit; end;
end;
if j=k1 then writeln('They are not the same!');
end;
begin {MAIN}
st1:='taskin1.dat'; assign(f1,st1); reset(f1);
readln(f1,str1); k1:=length(str1);
st2:='taskin2.dat'; assign(f2,st2); reset(f2);
readln(f2,str2); k2:=length(str2);
now:=meml[$40:$6c];
new(root1); new(root2);
creatree(root1,str1,k2);creatree(root2,str2,k2);
compare;
writeln((meml[$40:$6c]-now)/18.2:10:7); writeln; readln;
end.

也只有20分，请见谅！！

...全文