FireDAC 下的 Sqlite [10] - 使用 R-Tree 搜索

R-Tree 主要用於三維空間的搜索, 據說這種搜索算法非常之快, 哪怕百萬條記錄也是眨眼間的事!

SQLite 支持 1-5 維, FireDAC 也提供了 TFDSQLiteRTree 控件以方便定義回調函數. 為了簡單, 我用二維表進行了成功的測試.

建立 R-Tree 表(索引)時需要使用特定語法, 譬如:

FDConnection1.ExecSQL('CREATE VIRTUAL TABLE MyRTreeTable USING rtree(Id, minX, maxX, minY, maxY)');
//必須是 VIRTUAL 表
//USING rtree, 是必須的; 也可以是 USING rtree_i32
//Id, minX, maxX, minY, maxY; 這是 ID 與二維空間的數據, 這里無需指定參數類型; 因為參數類型是內定的: Id 是 64 位無符號整形(且是主鍵), 后面的數據是 32 位浮點
//如果使用 rtree_i32 定義, 后面的數據則都是 32 為整形; 另外如果指定了 SQLITE_RTREE_INT_ONLY 參數, 無論怎么定義, 內部都用整形計算.

---

為此我做了兩個例子, 第一個例子先沒有使用 TFDSQLiteRTree(也就是沒用回調).

本例除了使用 TFDConnection, TFDPhysSQLiteDriverLink, TFDGUIxWaitCursor, TDataSource, TDBGrid 外, 還有一個 TPaintBox, 用於繪圖和點擊測試, 用到它的 OnPaint 和 OnMouseUp 事件.

可把下面代碼直接貼在空白窗體上, 以快速完成窗體設計:
object PaintBox1: TPaintBox Left = 408 Top = 16 Width = 617 Height = 473 OnMouseUp = PaintBox1MouseUp OnPaint = PaintBox1Paint end object DBGrid1: TDBGrid Left = 0 Top = 0 Width = 393 Height = 503 Align = alLeft DataSource = DataSource1 TabOrder = 0 TitleFont.Charset = DEFAULT_CHARSET TitleFont.Color = clWindowText TitleFont.Height = -11 TitleFont.Name = 'Tahoma' TitleFont.Style = [] end object FDConnection1: TFDConnection Left = 34 Top = 24 end object FDPhysSQLiteDriverLink1: TFDPhysSQLiteDriverLink Left = 143 Top = 24 end object FDGUIxWaitCursor1: TFDGUIxWaitCursor Provider = 'Forms' Left = 260 Top = 24 end object FDQuery1: TFDQuery Connection = FDConnection1 Left = 32 Top = 88 end object DataSource1: TDataSource DataSet = FDQuery1 Left = 132 Top = 88 end object FDSQLiteRTree1: TFDSQLiteRTree DriverLink = FDPhysSQLiteDriverLink1 Left = 256 Top = 96 end

---

代碼:

var VBitmap: TBitmap; //當做內存畫布

procedure TForm1.FormCreate(Sender: TObject);
const
  W = 50; H = 30;
var
  i,x,y,x1,x2,y1,y2: Integer;
begin
  FDConnection1.Params.Add('DriverID=SQLite');
  FDConnection1.ExecSQL('CREATE VIRTUAL TABLE MyRTreeTable USING rtree(Id, minX, maxX, minY, maxY)'); //建表
  FDConnection1.Connected := True;

  {為數據庫添加模擬數據}
  FDConnection1.StartTransaction;
  try
    for i := 0 to 100 do
    begin
      x := Random(PaintBox1.Width);
      y := Random(PaintBox1.Height);
      FDConnection1.ExecSQL('INSERT INTO MyRTreeTable VALUES(:id, :x1, :x2, :y1, :y2)', [i, x, x+W, y, y+H]);
    end;
    FDConnection1.Commit;
  except
    FDConnection1.Rollback;
  end;

  {呈現}
  FDQuery1.Open('SELECT * FROM MyRTreeTable ORDER BY Id');
  for i := 0 to DBGrid1.Columns.Count - 1 do DBGrid1.Columns[i].Width := 66; //默認的網格列太寬了, 處理一下

  {根據剛剛添加的數據繪制一張內存圖片}
  VBitmap := TBitmap.Create;
  VBitmap.SetSize(PaintBox1.Width, PaintBox1.Height);
  VBitmap.Canvas.Brush.Color := clWhite;
  VBitmap.Canvas.FillRect(Rect(0, 0, VBitmap.Width, VBitmap.Height));

  FDQuery1.First;
  while not FDQuery1.Eof do
  begin
    x1 := FDQuery1.Fields[1].AsInteger;
    x2 := FDQuery1.Fields[2].AsInteger;
    y1 := FDQuery1.Fields[3].AsInteger;
    y2 := FDQuery1.Fields[4].AsInteger;
    VBitmap.Canvas.Brush.Color := Random($EEEEEE);
    VBitmap.Canvas.FillRect(Rect(x1, y1, x2, y2));
    FDQuery1.Next;
  end;
end;

{在 OnMouseUp 事件中執行了 R-Tree 搜索}
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
begin
  Caption := Format('%d, %d', [X, Y]);
  FDQuery1.Open('SELECT * FROM MyRTreeTable WHERE minX <= :X AND maxX > :X AND minY <= :Y AND maxY > :Y', [X,Y]); //[X,X,Y,Y] ?
  for i := 0 to DBGrid1.Columns.Count - 1 do DBGrid1.Columns[i].Width := 66; //這行只為縮小列寬
end;

{呈現前面繪制的內存圖片}
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.Draw(0, 0, VBitmap);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  VBitmap.Free;
end;

---

測試效果圖:

---

第二個例子效果同上, 但使用了 TFDSQLiteRTree, 它除了設定幾個參數外, 主要是使用其 OnCalculate, 該事件對應 SQLite 內部的相關回調函數.

---

var VBitmap: TBitmap;

{這是 FDSQLiteRTree1 的 OnCalculate 事件}
procedure TForm1.FDSQLiteRTree1Calculate(ARTree: TSQLiteRTreeData; const AParams, AColumns: TSQLiteRTreeDoubleArray; var AResult: Boolean);
begin
  AResult := PtInRect( //換成了 WinAPI.PtInRect
    Rect(Trunc(AColumns[0]), Trunc(AColumns[2]), Trunc(AColumns[1]), Trunc(AColumns[3])),  //是出 Id 外的空間的數據
    Point(Trunc(AParams[0]), Trunc(AParams[1]))                                            //AParams 是 MyRTreeCallback 函數的參數
  );
end;


procedure TForm1.FormCreate(Sender: TObject);
const
  W = 50; H = 30;
var
  i,x,y,x1,x2,y1,y2: Integer;
begin
  {添加了下面四行來設定 FDSQLiteRTree1 的參數, 這些參數一般可以在設計時指定}
  FDSQLiteRTree1.DriverLink := FDPhysSQLiteDriverLink1;
  FDSQLiteRTree1.RTreeName := 'MyRTreeCallback'; //這是后面 SQL 語句中使用的函數名
//  FDSQLiteRTree1.OnCalculate := FDSQLiteRTree1Calculate; //事件已在設計時指定
  FDSQLiteRTree1.Active := True;

  FDConnection1.Params.Add('DriverID=SQLite');
  FDConnection1.ExecSQL('CREATE VIRTUAL TABLE MyRTreeTable USING rtree(Id, minX, maxX, minY, maxY)'); //這行有改變
  FDConnection1.Connected := True;

  FDConnection1.StartTransaction;
  try
    for i := 0 to 100 do
    begin
      x := Random(PaintBox1.Width);
      y := Random(PaintBox1.Height);
      FDConnection1.ExecSQL('INSERT INTO MyRTreeTable VALUES(:id, :x1, :x2, :y1, :y2)', [i, x, x+W, y, y+H]);
    end;
    FDConnection1.Commit;
  except
    FDConnection1.Rollback;
  end;

  FDQuery1.Open('SELECT * FROM MyRTreeTable ORDER BY Id');
  for i := 0 to DBGrid1.Columns.Count - 1 do DBGrid1.Columns[i].Width := 66;

  VBitmap := TBitmap.Create;
  VBitmap.SetSize(PaintBox1.Width, PaintBox1.Height);
  VBitmap.Canvas.Brush.Color := clWhite;
  VBitmap.Canvas.FillRect(Rect(0, 0, VBitmap.Width, VBitmap.Height));

  FDQuery1.First;
  while not FDQuery1.Eof do
  begin
    x1 := FDQuery1.Fields[1].AsInteger;
    x2 := FDQuery1.Fields[2].AsInteger;
    y1 := FDQuery1.Fields[3].AsInteger;
    y2 := FDQuery1.Fields[4].AsInteger;
    VBitmap.Canvas.Brush.Color := Random($EEEEEE);
    VBitmap.Canvas.FillRect(Rect(x1, y1, x2, y2));
    FDQuery1.Next;
  end;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i: Integer;
begin
  Caption := Format('%d, %d', [X, Y]);
//  FDQuery1.Open('SELECT * FROM MyRTreeTable WHERE minX <= :X AND maxX > :X AND minY <= :Y AND maxY > :Y', [X,Y]);
  FDQuery1.Open('SELECT * FROM MyRTreeTable WHERE Id MATCH MyRTreeCallback(:X, :Y)', [X,Y]);  // MyRTreeCallback 是通過 FDSQLiteRTree1.RTreeName 指定的
  for i := 0 to DBGrid1.Columns.Count - 1 do DBGrid1.Columns[i].Width := 66;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.Draw(0, 0, VBitmap);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  VBitmap.Free;
end;

---