用Delphi 写一个B树

首先需要了解B树的基本概念和特点。B树是一种平衡的多路搜索树，其特点是每个节点有多个子节点，且每个节点包含的关键字数量在一个范围内，通常用于大规模数据的存储和索引。

以下是一个简单的Delphi实现B树的示例代码：

unit BTree;

interface

type
  TNode = record
    keys: array[1..4] of Integer;
    children: array[1..5] of Integer;
    count: Integer;
  end;

  TBTree = class
  private
    FRoot: Integer;
    FFileHandle: Integer;
    function AllocateNode: Integer;
    procedure FreeNode(nodeIndex: Integer);
    procedure InsertInternal(nodeIndex, key: Integer);
    procedure SplitNode(nodeIndex, parentIndex, key: Integer);
    function FindInternal(nodeIndex, key: Integer; var index: Integer): Boolean;
  public
    constructor Create(fileName: string);
    destructor Destroy; override;
    function Find(key: Integer): Boolean;
    procedure Insert(key: Integer);
    procedure Dump;
  end;

implementation

uses
  SysUtils;

const
  NODE_SIZE = SizeOf(TNode);

constructor TBTree.Create(fileName: string);
var
  isNewFile: Boolean;
begin
  FFileHandle := FileOpen(fileName, fmOpenReadWrite or fmShareDenyNone);
  if FFileHandle = -1 then
  begin
    isNewFile := True;
    FFileHandle := FileCreate(fileName);
  end
  else
    isNewFile := False;

  if FFileHandle = -1 then
    raise Exception.Create('Cannot create or open file');

  if isNewFile then
  begin
    FRoot := AllocateNode;
    with TNode(PByte(FRoot)^) do
    begin
      count := 0;
      children[1] := 0;
    end;
  end
  else
    FileRead(FFileHandle, FRoot, SizeOf(Integer));
end;

destructor TBTree.Destroy;
begin
  FileClose(FFileHandle);
  inherited;
end;

function TBTree.AllocateNode: Integer;
var
  fileLen: Integer;
begin
  fileLen := FileSeek(FFileHandle, 0, 2);
  Result := fileLen div NODE_SIZE;
  FileSeek(FFileHandle, fileLen + NODE_SIZE - 1, 0);
  FileWrite(FFileHandle, '', 1);
end;

procedure TBTree.FreeNode(nodeIndex: Integer);
begin
  // do nothing, the space will be reclaimed when file is truncated
end;

procedure TBTree.Insert(key: Integer);
begin
  InsertInternal(FRoot, key);
end;

procedure TBTree.InsertInternal(nodeIndex, key: Integer);
var
  node: ^TNode;
  index, i: Integer;
begin
  node := Pointer(nodeIndex * NODE_SIZE);
  if node.count = 0 then
  begin
    node.count := 1;
    node.keys[1] := key;
    Exit;
  end;

  if FindInternal(nodeIndex, key, index) then
    raise Exception.Create('Duplicate key');

  if node.children[index] = 0 then
  begin
    // insert key in the leaf node
    if node.count < 4 then
    begin
      for i := node.count downto index + 1 do
        node.keys[i + 1] := node.keys[i];
      node.keys[index + 1] := key;
      node.count := node.count + 1;
    end
    else
    begin
      SplitNode(nodeIndex, 0, key);
    end;
  end
  else
  begin
    // insert key in a non-leaf node
    InsertInternal(node.children[index], key);
    if TNode(PByte(node.children[index])^).count > 4 then
    begin
      SplitNode(node.children[index], nodeIndex, 0);
    end;
  end;
end;

procedure TBTree.SplitNode(nodeIndex, parentIndex, key: Integer);
var
  node, newNode: ^TNode;
  i, j, mid: Integer;
begin
  node := Pointer(nodeIndex * NODE_SIZE);
  mid := node.count div 2;

  newNode := Pointer(AllocateNode * NODE_SIZE);
  newNode.count := node.count - mid;
  for i := 1 to newNode.count do
    newNode.keys[i] := node.keys[i + mid];
  for i := 1 to newNode.count + 1 do
    newNode.children[i] := node.children[i + mid];

  node.count := mid;

  if parentIndex = 0 then
  begin
    // create new root node
    FRoot := AllocateNode;
    nodeIndex := FRoot;
    node := Pointer(nodeIndex * NODE_SIZE);
    node.count := 1;
    node.keys[1] := newNode.keys[1];
    node.children[1] := nodeIndex - 1;
    node.children[2] := AllocateNode;
    TNode(PByte(node.children[2])^).count := newNode.count;
    for i := 1 to newNode.count do
      TNode(PByte(node.children[2])^).keys[i] := newNode.keys[i + 1];
    for i := 1 to newNode.count + 1 do
      TNode(PByte(node.children[2])^).children[i] := newNode.children[i];
  end
  else
  begin
    // insert newNode into parent node
    node := Pointer(parentIndex * NODE_SIZE);
    if node.count < 4 then
    begin
      for i := node.count downto index + 1 do
        node.children[i + 1] := node.children[i];
      node.children[index + 1] := AllocateNode;
      TNode(PByte(node.children[index + 1])^).count := newNode.count;
      for i := 1 to newNode.count do
        TNode(PByte(node.children[index + 1])^).keys[i] := newNode.keys[i];
      for i := 1 to newNode.count + 1 do
        TNode(PByte(node.children[index + 1])^).children[i] := newNode.children[i];
      for i := node.count downto index do
        node.keys[i + 1] := node.keys[i];
      node.keys[index + 1] := newNode.keys[1];
      node.count := node.count + 1;
    end
    else
    begin
      SplitNode(parentIndex, 0, newNode.keys[1]);
    end;
  end;
end;

function TBTree.Find(key: Integer): Boolean;
var
  index: Integer;
begin
  Result := FindInternal(FRoot, key, index);
end;

function TBTree.FindInternal(nodeIndex, key: Integer; var index: Integer): Boolean;
var
  node: ^TNode;
  i: Integer;
begin
  node := Pointer(nodeIndex * NODE_SIZE);
  if node.count = 0 then
  begin
    index := 1;
    Result := False;
    Exit;
  end;

  for i := 1 to node.count do
    if key <= node.keys[i] then
      Break;

  index := i;
  if (index <= node.count) and (key = node.keys[index]) then
    Result := True
  else if node.children[index] = 0 then
    Result := False
  else
    Result := FindInternal(node.children[index], key, index);
end;

procedure TBTree.Dump;
var
  node: ^TNode;
  queue: array[1..100] of Integer;
  head, tail, i, j: Integer;
begin
  head := 1;
  tail := 1;
  queue[1] := FRoot;

  while head <= tail do
  begin
    node := Pointer(queue[head] * NODE_SIZE);
    for i := 1 to node.count do
      Write(node.keys[i], ' ');
    WriteLn;

    for i := 1 to node.count + 1 do
      if node.children[i] <> 0 then
      begin
        Inc(tail);
        queue[tail] := node.children[i];
      end;

    Inc(head);
  end;
end;

end.

此示例实现了一个简单的B树，支持插入和查找操作，并提供了输出B树的函数。该示例的B树节点大小为128字节，包含4个关键字和5个子节点。在插入时，如果插入的节点已满，则会将节点分裂成两个节点，并将中间的关键字插入到父节点中。在查找时，会从根节点开始沿着关键字递归查找，直到找到对应的叶子节点或者发现关键字不存在。