membintree.pas

Delphi快速开发Web Server

        end
      else
        begin
        p:=c^.r;
        c^.r:=p^.l;
        p^.l:=c;
        end;
      if (v<g^.key) then g^.l:=p else g^.r:=p;
      end;
    procedure x_rotate_gg;
      begin
      c:=g;
      if (v<c^.key) then
        begin
        x:=c^.l;
        c^.l:=x^.r;
        x^.r:=c;
        end
      else
        begin
        x:=c^.r;
        c^.r:=x^.l;
        x^.l:=c;
        end;
      if (v<gg^.key) then gg^.l:=x else gg^.r:=x;
      end;
    begin
    x^.b:=true;
    x^.l^.b:=false;
    x^.r^.b:=false;
    if (p^.b) then
      begin
      g^.b:=true;
      if (v<g^.key)<>(v<p^.key) then p_rotate_g;
      x_rotate_gg;
      x^.b:=false;
      end;
    head^.r^.b:=false;
    end;
  procedure split2;
    procedure p_rotate_g;
      begin
      if (v2<g^.info) then c:=g^.l2
      else if (v2>g^.info) then c:=g^.r2
      else if (v<g^.key) then c:=g^.l2
      else c:=g^.r2;
      if (v2<c^.info) then
        begin
        p:=c^.l2;
        c^.l2:=p^.r2;
        p^.r2:=c;
        end
      else if (v2>c^.info) then
        begin
        p:=c^.r2;
        c^.r2:=p^.l2;
        p^.l2:=c;
        end
      else if (v<c^.key) then
        begin
        p:=c^.l2;
        c^.l2:=p^.r2;
        p^.r2:=c;
        end
      else
        begin
        p:=c^.r2;
        c^.r2:=p^.l2;
        p^.l2:=c;
        end;
      if (v2<g^.info) then g^.l2:=p
      else if (v2>g^.info) then g^.r2:=p
      else if (v<g^.key) then g^.l2:=p
      else g^.r2:=p;
      end;
    procedure x_rotate_gg;
      begin
      if (v2<gg^.info) then c:=gg^.l2
      else if (v2>gg^.info) then c:=gg^.r2
      else if (v<gg^.key) then c:=gg^.l2
      else c:=gg^.r2;
      if (v2<c^.info) then
        begin
        x:=c^.l2;
        c^.l2:=x^.r2;
        x^.r2:=c;
        end
      else if (v2>c^.info) then
        begin
        x:=c^.r2;
        c^.r2:=x^.l2;
        x^.l2:=c;
        end
      else if (v<c^.key) then
        begin
        x:=c^.l2;
        c^.l2:=x^.r2;
        x^.r2:=c;
        end
      else
        begin
        x:=c^.r2;
        c^.r2:=x^.l2;
        x^.l2:=c;
        end;
      if (v2<gg^.info) then gg^.l2:=x
      else if (v2>gg^.info) then gg^.r2:=x
      else if (v<gg^.key) then gg^.l2:=x
      else gg^.r2:=x;
      end;
    begin
    x^.b2:=true;
    x^.l2^.b2:=false;
    x^.r2^.b2:=false;
    if (p^.b2) then
      begin
      g^.b2:=true;
      if ( (v2<g^.info) or ((v2=g^.info) and (v<g^.key)) ) <>
         ( (v2<p^.info) or ((v2=p^.info) and (v<p^.key)) ) then p_rotate_g;
      x_rotate_gg;
      x^.b2:=false;
      end;
    head^.r2^.b2:=false;
    end;
  begin
  nx:=new_node(v,info,True,z,z);

  // Key Sort
  x:=head; p:=head; g:=head;
  while (x<>z) do
    begin
    gg:=g; g:=p; p:=x;
    if (v<x^.key) then x:=x^.l else x:=x^.r;
    if (x^.l^.b and x^.r^.b) then split;
    end;
  x:=nx;
  if (v<p^.key) then p^.l:=x else p^.r:=x;
  split;

  // Info Sort
  v2:=info;
  x:=head; p:=head; g:=head;
  while (x<>z) do
    begin
    gg:=g; g:=p; p:=x;
    if (v2<x^.info) then x:=x^.l2
    else if (v2>x^.info) then x:=x^.r2
    else if (v<x^.key) then x:=x^.l2
    else x:=x^.r2;
    if (x^.l2^.b2 and x^.r2^.b2) then split2;
    end;
  x:=nx;
  if (v2<p^.info) then p^.l2:=x
  else if (v2>p^.info) then p^.r2:=x
  else if (v<p^.key) then p^.l2:=x
  else p^.r2:=x;
  split2;
  Inc(cnt);
  end;

procedure tBinTree.Remove(const v:itemType);
// Remove
  var
    cb:boolean;
    c,p,g,y,p2,x,t:pnode;
    v2:infoType;
  procedure AddParentNode(node:pnode);
    begin
    if node<>nil then
      with Parents^ do
        begin
        Nodes[NodeCount]:=node;
        Inc(NodeCount);
        end;
    end;
  function GetParentNode:pnode;
    begin
    with Parents^ do
      if NodeCount=0 then
        Result:=z
      else
        begin
        Dec(NodeCount);
        Result:=Nodes[NodeCount];
        end;
    end;
  procedure InitParentNodes;
    begin
    Parents^.NodeCount:=0;
    end;
  procedure SwapParentNode;
    var
      a:byte;
    begin
    with Parents^ do
      for a:=0 to NodeCount-1 do
        if Nodes[a]=t then
          begin
          Nodes[a]:=c;
          Break;
          end;
    end;
  procedure deleteFixup;
    procedure p_rotateLeft_g;
      begin
      AddParentNode(g);
      p^.r := y^.l;
      if (p = g^.r) then g^.r := y else g^.l := y;
      y^.l := p;
      g:=y; y:=p^.r;
      end;
    procedure p_rotateRight_g;
      begin
      AddParentNode(g);
      p^.l := y^.r;
      if (p = g^.l) then g^.l := y else g^.r := y;
      y^.r := p;
      g:=y; y:=p^.l;
      end;
    procedure y_rotateRight_p;
      begin
      c := y^.l;
      y^.l := c^.r;
      if (p^.r = y) then p^.r := c else p^.l := c;
      c^.r := y;
      y := p^.r;
      end;
    procedure y_rotateLeft_p;
      begin
      c := y^.r;
      y^.r := c^.l;
      if (p^.l = y) then p^.l := c else p^.r := c;
      c^.l := y;
      y := p^.l;
      end;
    begin
    p:=GetParentNode;
    g:=GetParentNode;
    while (x <> head^.r) and (x^.b = false) do
      begin
      if (x = p^.l) then
        begin
        y:=p^.r;
        if (y^.b = true) then
          begin
          y^.b := false;
          p^.b := true;
          p_rotateLeft_g;
          end;
        if (y^.l^.b = false) and (y^.r^.b = false) then
          begin
          y^.b := true;
          x := p; p := g; g := GetParentNode;
          end
        else if (p<>head) then
          begin
          if (y^.r^.b = false) then
            begin
            y^.l^.b := false;
            y^.b := true;
            y_rotateRight_p;
            end;
          y^.b := p^.b;
          p^.b := false;
          y^.r^.b := false;
          p_rotateLeft_g;
          x:=head^.r;
          break;
          end;
        end
      else
        begin
        y:=p^.l;
        if (y^.b = true) then
          begin
          y^.b := false;
          p^.b := true;
          p_rotateRight_g;
          end;
        if (y^.r^.b = false) and (y^.l^.b = false) then
          begin
          y^.b := true;
          x := p; p := g; g := GetParentNode;
          end
        else
          begin
          if (y^.l^.b = false) then
            begin
            y^.r^.b := false;
            y^.b := true;
            y_rotateLeft_p;
            end;
          y^.b := p^.b;
          p^.b := false;
          y^.l^.b := false;
          p_rotateRight_g;
          x:=head^.r;
          break;
          end;
        end;
      end;
    if (x<>z) then x^.b := false;
    end;
  procedure deleteFixup2;
    procedure p_rotateLeft_g;
      begin
      AddParentNode(g);
      p^.r2 := y^.l2;
      if (p = g^.r2) then g^.r2 := y else g^.l2 := y;
      y^.l2 := p;
      g:=y; y:=p^.r2;
      end;
    procedure p_rotateRight_g;
      begin
      AddParentNode(g);
      p^.l2 := y^.r2;
      if (p = g^.l2) then g^.l2 := y else g^.r2 := y;
      y^.r2 := p;
      g:=y; y:=p^.l2;
      end;
    procedure y_rotateRight_p;
      begin
      c := y^.l2;
      y^.l2 := c^.r2;
      if (p^.r2 = y) then p^.r2 := c else p^.l2 := c;
      c^.r2 := y;
      y := p^.r2;
      end;
    procedure y_rotateLeft_p;
      begin
      c := y^.r2;
      y^.r2 := c^.l2;
      if (p^.l2 = y) then p^.l2 := c else p^.r2 := c;
      c^.l2 := y;
      y := p^.l2;
      end;
    begin
    p:=GetParentNode;
    g:=GetParentNode;
    while (x <> head^.r2) and (x^.b2 = false) do
      begin
      if (x = p^.l2) then
        begin
        y:=p^.r2;
        if (y^.b2 = true) then
          begin
          y^.b2 := false;
          p^.b2 := true;
          p_rotateLeft_g;
          end;
        if (y^.l2^.b2 = false) and (y^.r2^.b2 = false) then
          begin
          y^.b2 := true;
          x := p; p := g; g := GetParentNode;
          end
        else if (p<>head) then
          begin
          if (y^.r2^.b2 = false) then
            begin
            y^.l2^.b2 := false;
            y^.b2 := true;
            y_rotateRight_p;
            end;
          y^.b2 := p^.b2;
          p^.b2 := false;
          y^.r2^.b2 := false;
          p_rotateLeft_g;
          x:=head^.r2;
          break;
          end;
        end
      else
        begin
        y:=p^.l2;
        if (y^.b2 = true) then
          begin
          y^.b2 := false;
          p^.b2 := true;
          p_rotateRight_g;
          end;
        if (y^.r2^.b2 = false) and (y^.l2^.b2 = false) then
          begin
          y^.b2 := true;
          x := p; p := g; g := GetParentNode;
          end
        else
          begin
          if (y^.l2^.b2 = false) then
            begin
            y^.r2^.b2 := false;
            y^.b2 := true;
            y_rotateLeft_p;
            end;
          y^.b2 := p^.b2;
          p^.b2 := false;
          y^.l2^.b2 := false;
          p_rotateRight_g;
          x:=head^.r2;
          break;
          end;
        end;
      end;
    if (x<>z) then x^.b2 := false;
    end;
  begin
  InitParentNodes;
  p:=head; t:=head^.r;
  AddParentNode(p);
  while (t<>z) and (v<>t^.key) do
    begin
    p:=t;
    AddParentNode(p);
    if (v<t^.key) then t:=t^.l else t:=t^.r;
    end;

  if t=z then
    raise Exception.Create('Key not found !');

  if (t^.r=z) then
    begin
    cb:=t^.b;
    x:=t^.l;
    if (p^.l=t) then p^.l:=x else p^.r:=x;
    end
  else if (t^.l=z) then
    begin                                        
    cb:=t^.b;
    x:=t^.r;
    if (p^.l=t) then p^.l:=x else p^.r:=x;
    end
  else
    begin
    p2:=p; c:=t^.r;
    if c^.l=z then
      begin
      AddParentNode(c);
      x:=c^.r;
      cb:=c^.b;
      c^.b:=t^.b;
      c^.l:=t^.l;
      if p2^.l=t then p2^.l:=c else p2^.r:=c;
      end
    else
      begin
      AddParentNode(t);
      repeat
        AddParentNode(c); p:=c;
        c:=c^.l;
        until c^.l=z;
      SwapParentNode;
      x:=c^.r; p^.l:=x;
      cb:=c^.b;
      c^.b:=t^.b;
      c^.l:=t^.l;
      c^.r:=t^.r;
      if p2^.l=t then p2^.l:=c else p2^.r:=c;
      end;
    end;
  if cb=false then deleteFixup;

  v2:=t^.info;
  InitParentNodes;
  p:=head;x:=head^.r2;
  AddParentNode(p);
  while (x<>z) and (v<>x^.key) do
    begin
    p:=x;
    AddParentNode(p);
    if (v2<x^.info) then x:=x^.l2
    else if (v2>x^.info) then x:=x^.r2
    else if (v<x^.key) then x:=x^.l2
    else x:=x^.r2;
    end;
  if t<>x then
    raise Exception.Create('BinTree -> structure corrupt !');

  if (t^.r2=z) then
    begin
    cb:=t^.b2;
    x:=t^.l2;
    if (p^.l2=t) then p^.l2:=x else p^.r2:=x;
    end
  else if (t^.l2=z) then
    begin
    cb:=t^.b2;
    x:=t^.r2;
    if (p^.l2=t) then p^.l2:=x else p^.r2:=x;
    end
  else
    begin
    p2:=p; c:=t^.r2;
    if c^.l2=z then
      begin
      AddParentNode(c);
      x:=c^.r2;
      cb:=c^.b2;
      c^.b2:=t^.b2;
      c^.l2:=t^.l2;
      if p2^.l2=t then p2^.l2:=c else p2^.r2:=c;
      end
    else
      begin
      AddParentNode(t);
      repeat
        AddParentNode(c); p:=c;
        c:=c^.l2;
        until c^.l2=z;
      SwapParentNode;
      x:=c^.r2; p^.l2:=x;
      cb:=c^.b2;
      c^.b2:=t^.b2;
      c^.l2:=t^.l2;
      c^.r2:=t^.r2;
      if p2^.l2=t then p2^.l2:=c else p2^.r2:=c;
      end;
    end;
  if cb=false then deleteFixup2;
  t^.info:=infoNil;
  t^.key:=itemMin;
  del_node(t);
  Dec(cnt);
  end;

function tBinTree.Count: cardinal;
  begin
  Result:=cnt;
  end;

end.