Pascal中的AVL-tree：旋转导致错误202--stack overflow；为什么？

Question

以下用于实现 AVL 树插入和删除的代码给出了 错误 #202（堆栈溢出）。

源代码如下所示：

program Avl_generator; uses Crt;

type p_Avl = ^Avl_node;
 Avl_node = record
 key: integer;
 l, r, par: p_Avl; {pointers to left child, right child, parent}
 bal, h: integer {balance factor, height}
 end;

procedure init(var root: p_Avl); begin new(root); root:=nil end;

function get_height(var n: p_Avl): integer;
begin
  if(n=nil) then get_height:=-1 else get_height:=n^.h;
end;

procedure reheight(var n: p_Avl); {refresh the height variable}
begin
  if(n<>nil) then
  begin
    if(get_height(n^.r)>get_height(n^.l)) then n^.h:=1+get_height(n^.r)
      else n^.h:=1+get_height(n^.l);
  end;
end;

procedure set_balance(var n: p_Avl); begin reheight(n); n^.bal:=get_height(n^.r)-get_height(n^.l); end; {refresh the balance factor}

function rotate_l(var a: p_Avl): p_Avl; {left rotation, a is pivot}
var b: p_Avl;
begin
  b := a^.r;
  b^.par := a^.par;
  a^.r := b^.l;
  if(a^.r<>nil) then a^.r^.par := a;
  b^.l := a;
  a^.par := b;
  if(b^.par<>nil) then
    if(b^.par^.r=a) then b^.par^.r := b
      else b^.par^.l := b;
  set_balance(a); set_balance(b);
  rotate_l := b;
end;

function rotate_r(var a: p_Avl): p_Avl; {right rotation, a is pivot}
var b: p_Avl;
begin
  b := a^.l;
  b^.par := a^.par;
  a^.l := b^.r;
  if(a^.l<>nil) then a^.l^.par := a;
  b^.r := a;
  a^.par := b;
  if(b^.par<>nil) then
    if(b^.par^.r=a) then b^.par^.r := b
      else b^.par^.l := b;
  set_balance(a); set_balance(b);
  rotate_r := b;
end;

function rotate_l_r(var a: p_Avl): p_Avl; {left & right rotation, a is pivot}
begin
  a^.l := rotate_l(a^.l);
  rotate_l_r := rotate_r(a);
end;

function rotate_r_l(var a: p_Avl): p_Avl; {right & left rotation, a is pivot}
begin
  a^.r := rotate_r(a^.r);
  rotate_r_l := rotate_l(a);
end;

procedure rebalance(var root: p_Avl; var n: p_Avl); {refresh balance factors and see if sub-trees need rotating}
begin
  set_balance(n);
  if(n^.bal=-2) then
  begin
    if(get_height(n^.l^.l)>=get_height(n^.l^.r)) then n:=rotate_r(n)
      else n:=rotate_l_r(n);
  end
  else if(n^.bal=2) then
  begin
    if(get_height(n^.r^.r)>=get_height(n^.r^.l)) then n:=rotate_l(n)
      else n:=rotate_r_l(n);
  end;
  if(n^.par<>nil) then rebalance(root, n^.par) else root:=n; {recursion here}
end;

procedure insert(var root: p_Avl; what: integer);
var found: boolean;
  pre_tmp, tmp: p_Avl;
begin
  found:=false; tmp:=root; pre_tmp:= nil;
  while(tmp<>nil) and not found do
    if(tmp^.key=what) then found:=true
      else if(tmp^.key>what) then begin pre_tmp:=tmp; tmp:=tmp^.l end
      else begin pre_tmp:=tmp; tmp:=tmp^.r end;

  if not found then
  begin
    new(tmp); tmp^.key:=what;
    tmp^.l:=nil; tmp^.r:=nil; tmp^.par:=pre_tmp; tmp^.h:=0; tmp^.bal:=0;
    if(pre_tmp=nil) then root:=tmp
      else
      begin
        if(pre_tmp^.key>what) then pre_tmp^.l:=tmp else pre_tmp^.r:=tmp;
        rebalance(root, pre_tmp);
      end;
  end;
end;

procedure delete(var root: p_Avl; what: integer);
var found: boolean;
  tmp, pre_tmp, act, pre_act: p_Avl;
begin
  found:=false; tmp:=root; pre_tmp:=nil;
  while(tmp<>nil) and not found do
  begin
    if(tmp^.key=what) then found:=true
      else if(tmp^.key>what) then
        begin pre_tmp:=tmp; tmp:=tmp^.l end
      else
        begin pre_tmp:=tmp; tmp:=tmp^.r end;
    if found then
      if(tmp^.l=nil) then
      begin
        if(pre_tmp=nil) then root:=tmp^.r
          else if(pre_tmp^.key>what) then pre_tmp^.l:=tmp^.r
          else pre_tmp^.r:=tmp^.r;
        dispose(tmp); rebalance(root,pre_tmp);
      end else if(tmp^.r=nil) then
      begin
        if(pre_tmp=nil) then root:=tmp^.l
          else if(pre_tmp^.key>what) then pre_tmp^.l:=tmp^.l
          else begin pre_tmp^.r:=tmp^.l end;
        dispose(tmp); rebalance(root,pre_tmp);
      end else
      begin
        act:=tmp^.l; pre_act:=nil;
        while(act^.r<>nil) do begin pre_act:=act; act:=act^.r end;
        tmp^.key:=act^.key;
        if(pre_act=nil) then begin tmp^.l:=act^.l; dispose(act); rebalance(root,tmp) end
          else begin pre_act^.r:=act^.l; dispose(act); rebalance(root,pre_act) end;
      end;
  end;
end;

var Avl_tree: p_Avl;
begin
  init(Avl_tree);
  insert(Avl_tree,1);
  insert(Avl_tree,2);
  insert(Avl_tree,3);
  insert(Avl_tree,4);
  insert(Avl_tree,5);
  writeln(get_path(Avl_tree, 5));
  repeat until KeyPressed;
end.

这编译得很好（Turbo Pascal 7.0）。但是，当我运行代码时，错误发生在 rotate_l 过程中，该过程在第三次插入 之后被调用 （于是根节点的平衡因子=2.

我查了一些Java&C++的实现，里面的旋转方式好像和我的很像，不知道问题出在哪里..?

Answer 1

好吧，我上次接触 Pascal 已经 14 年了:)

所以问题确实出在 rotate_l 函数上。您正在传递 a 参数 by-reference，如 var 关键字所示。

     rotate_l(var a: p_Avl)

这会导致 a 在您覆盖 b.par 时变为 nil，因为 a references 在该特定函数调用中 b.par 的地址，并且您将 b.par 设置为 nil。所以 a 现在正在引用包含 nil 的内存位置。

您需要更改函数签名以按值传递a 参数。这是通过删除 var 关键字来完成的。

rotate_l(a: p_Avl)

堆栈溢出是由 rebalance 过程中的相同问题引起的：

改变

procedure rebalance(var root: p_Avl; var n: p_Avl);

到

procedure rebalance(var root: p_Avl; n: p_Avl);

有关参数，请参阅 Free Pascal 语言参考 http://wiki.lazarus.freepascal.org/Parameters

Pascal中的AVL-tree：旋转导致错误202--stack overflow；为什么？

AVL-tree in Pascal: rotation results in Error 202--stack overflow; why?

pascal

avl-tree