You've already forked lazarus-ccr
LazMapViewer: Add unit test for distance calculation
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8793 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -166,6 +166,7 @@ type
|
||||
|
||||
function RealPoint(Lat, Lon: Double): TRealPoint;
|
||||
|
||||
function HaversineDist(Lat1, Lon1, Lat2, Lon2, Radius: Double): Double;
|
||||
function CalcGeoDistance(Lat1, Lon1, Lat2, Lon2: double;
|
||||
AUnits: TDistanceUnits = duKilometers): double;
|
||||
|
||||
@ -734,7 +735,7 @@ const
|
||||
MIN_LONGITUDE = -180;
|
||||
MAX_LONGITUDE = 180;
|
||||
var
|
||||
zoomfac: Extended;
|
||||
zoomfac: Int64;
|
||||
begin
|
||||
// https://epsg.io/3857
|
||||
// https://pubs.usgs.gov/pp/1395/report.pdf, page 41
|
||||
@ -776,7 +777,7 @@ var
|
||||
Cpm: Extended;
|
||||
Z: Integer;
|
||||
t, phi: Extended;
|
||||
zoomFac: Extended; // 2**Z
|
||||
zoomFac: Int64;
|
||||
i: Integer;
|
||||
begin
|
||||
// https://epsg.io/3395
|
||||
@ -1549,42 +1550,37 @@ begin
|
||||
ADeg := sgn * (abs(ADeg) + mins / 60 + secs / 3600);
|
||||
end;
|
||||
|
||||
// https://stackoverflow.com/questions/73608975/pascal-delphi-11-formula-for-distance-in-meters-between-two-decimal-gps-point
|
||||
function HaversineDist(Lat1, Lon1, Lat2, Lon2, Radius: Double): Double;
|
||||
var
|
||||
latFrom, latTo, lonDiff: Double;
|
||||
dx, dy, dz: Double;
|
||||
begin
|
||||
lonDiff := DegToRad(Lon1 - Lon2);
|
||||
latFrom := DegToRad(Lat1);
|
||||
latTo := DegToRad(Lat2);
|
||||
|
||||
dz := sin(latFrom) - sin(latTo);
|
||||
dx := cos(lonDiff) * cos(latFrom) - cos(latTo);
|
||||
dy := sin(lonDiff) * cos(latFrom);
|
||||
|
||||
Result := arcsin(sqrt(sqr(dx) + sqr(dy) + sqr(dz)) / 2) * Radius * 2;
|
||||
end;
|
||||
|
||||
|
||||
{ Returns the direct distance (air-line) between two geo coordinates
|
||||
If latitude NOT between -90°..+90° and longitude NOT between -180°..+180°
|
||||
the function returns -1.
|
||||
Usage: FindDistance(51.53323, -2.90130, 51.29442, -2.27275, duKilometers);
|
||||
the function returns NaN.
|
||||
Usage: CalcGeoDistance(51.53323, -2.90130, 51.29442, -2.27275, duKilometers);
|
||||
}
|
||||
function CalcGeoDistance(Lat1, Lon1, Lat2, Lon2: double;
|
||||
AUnits: TDistanceUnits = duKilometers): double;
|
||||
const
|
||||
EPS = 1E-12;
|
||||
var
|
||||
d_radians: double; // distance in radians
|
||||
lat1r, lon1r, lat2r, lon2r: double;
|
||||
arg: Double;
|
||||
begin
|
||||
// Validate
|
||||
if (Lat1 < -90.0) or (Lat1 > 90.0) then exit(NaN);
|
||||
// if (Lon1 < -180.0) or (Lon1 > 180.0) then exit(NaN);
|
||||
if (Lat2 < -90.0) or (Lat2 > 90.0) then exit(NaN);
|
||||
// if (Lon2 < -180.0) or (Lon2 > 180.0) then exit(NaN);
|
||||
|
||||
// Turn lat and lon into radian measures
|
||||
lat1r := (PI / 180.0) * Lat1;
|
||||
lon1r := (PI / 180.0) * Lon1;
|
||||
lat2r := (PI / 180.0) * Lat2;
|
||||
lon2r := (PI / 180.0) * Lon2;
|
||||
|
||||
// calc
|
||||
arg := sin(lat1r) * sin(lat2r) + cos(lat1r) * cos(lat2r) * cos(lon1r - lon2r);
|
||||
if (arg < -1) or (arg > +1) then
|
||||
exit(NaN);
|
||||
if SameValue(abs(Lon1-Lon2), 360, EPS) and SameValue(abs(arg), 1.0, EPS) then
|
||||
d_radians := PI * 2.0
|
||||
else
|
||||
d_radians := arccos(arg);
|
||||
Result := EARTH_EQUATORIAL_RADIUS * d_radians;
|
||||
|
||||
Result := HaversineDist(Lat1, Lon1, Lat2, Lon2, EARTH_EQUATORIAL_RADIUS);
|
||||
case AUnits of
|
||||
duMeters: ;
|
||||
duKilometers: Result := Result * 1E-3;
|
||||
|
@ -10,6 +10,7 @@ uses
|
||||
type
|
||||
TMiscTests_Engine= class(TTestCase)
|
||||
published
|
||||
procedure Test_Distance;
|
||||
procedure Test_LatToStr_DMS;
|
||||
procedure Test_LatToStr_Deg;
|
||||
procedure Test_LonToStr_DMS;
|
||||
@ -23,6 +24,29 @@ implementation
|
||||
uses
|
||||
Math, mvEngine;
|
||||
|
||||
type
|
||||
TDistanceRec = record
|
||||
Name1: String;
|
||||
Lat1, Lon1: Double;
|
||||
Name2: String;
|
||||
Lat2, Lon2: Double;
|
||||
Distance_km: Double;
|
||||
end;
|
||||
|
||||
const
|
||||
Distance_TestData: array[0..2] of TDistanceRec = (
|
||||
// Calculated on https://keisan.casio.com/exec/system/1224587128 for R=6378km
|
||||
(Name1: 'Sydney'; Lat1:-33.865143; Lon1:151.209900;
|
||||
Name2: 'San Francisco'; Lat2:37.828724; Lon2:-122.355537;
|
||||
Distance_km: 11968),
|
||||
(Name1: 'London'; Lat1: 51.503368; Lon1: -0.127721;
|
||||
Name2: 'Istanbul'; Lat2: 41.276901; Lon2: 28.729324;
|
||||
Distance_km: 2468.6),
|
||||
(Name1: 'Tokyo'; Lat1:35.652832; Lon1:139.839478;
|
||||
Name2: 'Singapore'; Lat2:1.290270; Lon2:103.851959;
|
||||
Distance_km: 5331.97)
|
||||
);
|
||||
|
||||
type
|
||||
TLatLonRec = record
|
||||
Name: String;
|
||||
@ -38,9 +62,6 @@ type
|
||||
Lon_S: Double;
|
||||
end;
|
||||
|
||||
var
|
||||
PointFormatsettings: TFormatSettings;
|
||||
|
||||
const
|
||||
LatLon_TestData: array[0..7] of TLatLonRec = (
|
||||
(Name:'Sydney'; // https://www.latlong.net/place/sydney-nsw-australia-700.html
|
||||
@ -70,6 +91,25 @@ const
|
||||
);
|
||||
|
||||
|
||||
var
|
||||
PointFormatsettings: TFormatSettings;
|
||||
|
||||
procedure TMiscTests_Engine.Test_Distance;
|
||||
const
|
||||
TOLERANCE = 2;
|
||||
RADIUS = 6378; // Earth radius in km, as used by the references
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to High(Distance_TestData) do
|
||||
with Distance_TestData[i] do
|
||||
AssertEquals(
|
||||
'Distance mismatch between ' + Name1 + ' and ' + Name2,
|
||||
Distance_km,
|
||||
HaverSineDist(Lat1, Lon1, Lat2, Lon2, RADIUS), TOLERANCE
|
||||
);
|
||||
end;
|
||||
|
||||
procedure TMiscTests_Engine.Test_LatToStr_Deg;
|
||||
const
|
||||
NO_DMS = false;
|
||||
|
Reference in New Issue
Block a user