Geodistance Delphi Test

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Math;

type
  TCoordNumber = Real;

  TCoords = record
    coId: Cardinal;
    coLon: TCoordNumber;
    coLat: TCoordNumber;
  end;

  TfrmMain = class(TForm)
    btnGo: TButton;
    btnTestDist: TButton;
    procedure FormDestroy(Sender: TObject);
    procedure btnTestDistClick(Sender: TObject);
    procedure btnGoClick(Sender: TObject);
  private
    procedure InitData;
  public
  end;

const
  CoordsQty = 2 * 1000 * 1000;

var
  frmMain: TfrmMain;
  GeoCoords: array of TCoords; // it will be slower if you move GeoCoords into the class

implementation

{$R *.dfm}

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  Finalize(GeoCoords);
end;

function GetDistanceKm(lat1, lon1, lat2, lon2: TCoordNumber): Extended;
var rn1, re1, rn2, re2, rd: Extended;
begin
  rn1 := lat1 * Pi / 180;
  re1 := lon1 * Pi / 180;
  rn2 := lat2 * Pi / 180;
  re2 := lon2 * Pi / 180;
  rd:=60*ArcCos(Sin(rn1)*Sin(rn2)+Cos(rn1)*Cos(rn2)*Cos(re2-re1));
  GetDistanceKm := 1.852 * rd * 180 / Pi;
end;

procedure TfrmMain.InitData;
var i: Integer; s: string;
begin
  s := Caption;
  Show;
  SetLength(GeoCoords, CoordsQty);
  Randomize;
  for i := 0 to High(GeoCoords) do
   begin
    with GeoCoords[i] do
     begin
      coId := i + 1;
      coLon := Random(360) + Random - 180;
      coLat := Random(180) + Random - 90;
     end;
    if i and $FFFF = 0 then
     begin
      Caption := Caption + '|';
      Application.ProcessMessages;
     end;
   end;
  Caption := s;
end;

procedure TfrmMain.btnGoClick(Sender: TObject);
const RetryCount = 1000;
var i, n, FoundQty: Integer;
  TestLat, TestLon: TCoordNumber;
  TestDist, CurrDist: Real;
  StartTick, DeltaTime: DWord;
begin
  btnGo.Enabled := False;

  FoundQty := 0;
  TestDist := 5; // 5 km
  TestLat := 50.45; // y, "с.ш.",
  TestLon := 30.52; // x, "в.д.",

  InitData;
  StartTick := GetTickCount;

  for n := 1 to 1000 do
   for i := 0 to High(GeoCoords) do
    with GeoCoords[i] do
     // 1 градус широты — примерно 111 км
     if (abs(coLat - TestLat) * 100 < TestDist) then
      // 1 градус долготы — 111.3 ... 0 км (19.8 км на параллели 80°)
      if (abs(abs(coLon) - abs(TestLon)) * 10 < TestDist) then
       begin
        CurrDist := GetDistanceKm(TestLat, TestLon, coLat, coLon);
        if CurrDist < TestDist then
         Inc(FoundQty);
       end;

  DeltaTime := GetTickCount - StartTick;
  // у меня 1000 поисков по 2 млн. записям за 4.5 секунды
  ShowMessage(IntToStr(RetryCount) + ' searches over ' + IntToStr(CoordsQty) +
    ' records were performed during ' + IntToStr(DeltaTime) + ' ms. Found ' +
    IntToStr(FoundQty) + ' records using distance ' + FloatToStr(TestDist) + ' km');

  btnGo.Enabled := True;
end;

procedure TfrmMain.btnTestDistClick(Sender: TObject);
var n1, e1, n2, e2: TCoordNumber;
begin
  n1 := 55.751052;
  e1 := 37.623968;
  n2 := 50.450000;
  e2 := 30.524167;
  ShowMessage('Distance is ' + FloatToStr(GetDistanceKm(n1, e1, n2, e2)) + ' km');
  // Must be 755.092 km
end;

end.