Geo-CheapRuler

 view release on metacpan or  search on metacpan

test/test.pl  view on Meta::CPAN


my $lines = [
	[ [ -96.920341, 32.838261 ], [ -96.920421, 32.838295 ], [ -96.920421, 32.838295 ], [ -96.920536, 32.838297 ], [ -96.920684, 32.838293 ], [ -96.920818, 32.838342 ] ],
	[ [ -96.920349, 32.838306 ], [ -96.920421, 32.838295 ] ],
	[ [ -96.919874, 32.837479 ], [ -96.920097, 32.837684 ], [ -96.92018, 32.837844 ], [ -96.92029, 32.838216 ], [ -96.920341, 32.838261 ] ],
	[ [ -96.915781, 32.834689 ], [ -96.915735, 32.834529 ], [ -96.91573, 32.834443 ], [ -96.915733, 32.834286 ], [ -96.915853, 32.8337 ] ],
	[ [ -96.915092, 32.836889 ], [ -96.915915, 32.836977 ] ],
	[ [ -96.914617, 32.83752 ], [ -96.914507, 32.838106 ], [ -96.914319, 32.839063 ] ],
	[ [ -96.915671, 32.833443 ], [ -96.915427, 32.833817 ], [ -96.91532, 32.833963 ], [ -96.915247, 32.834072 ], [ -96.915062, 32.834252 ], [ -96.914775, 32.834518 ] ],
	[ [ -96.9104, 32.837119 ], [ -96.910567, 32.837069 ], [ -96.9111, 32.836941 ] ],
	[ [ -96.91441, 32.836582 ], [ -96.914225, 32.836544 ], [ -96.914158, 32.836499 ], [ -96.914107, 32.836449 ], [ -96.914075, 32.836393 ], [ -96.914059, 32.836292 ], [ -96.914091, 32.836073 ], [ -96.914649, 32.834919 ], [ -96.914837, 32.834601 ], [ -96...
	[ [ -96.914155, 32.836758 ], [ -96.913391, 32.836697 ], [ -96.912991, 32.836643 ], [ -96.912847, 32.836589 ], [ -96.912761, 32.836508 ], [ -96.912573, 32.836433 ] ],
	[ [ -96.917377, 32.837281 ], [ -96.917589, 32.837317 ], [ -96.918117, 32.837339 ] ], [ [ -96.920815, 32.836594 ], [ -96.919732, 32.836643 ], [ -96.918975, 32.836702 ], [ -96.918077, 32.836729 ], [ -96.916661, 32.83672 ], [ -96.916358, 32.836774 ] ],...
];

my $bearing = [-63.168358499156525,0,-88.81417863576165,-91.84236975813288,-66.4804397776352,95.21979003879285,-100.30570881092109,150.61043051857857,-42.42680621413666,-23.550372000573976,-13.952505152879572,-43.59833577684526,132.99198010184847,166...

my $dest= [[-96.920341,32.82926779636275],[-96.92060778450087,32.829303165932515],[-96.92079451212265,32.82930727422472],[-96.9210961260162,32.82931611998831],[-96.92143056929962,32.82932170113868],[-96.92175078577964,32.82938301475816],[-96.92146771...

my $line_d = [
  0.046609981574718906, 0.006837014573958606,  0.09982096963311761,
   0.11145486692082905,  0.07751139204101343,  0.17381925202277865,
   0.14676779064907625,  0.06835463295054281,   0.4305992420136874,
    0.1557978717029982,  0.06959752243825565,   0.4175473486544049,
    0.1134246533617343,   0.4067920086631963,   0.0912417649765146,
   0.21051279092490788,   0.9728177474330546,   0.3420448027669489,
   0.24824621320909163,  0.34582337602506064,   0.2694827378486251,
  0.003791006838911109,  0.33104204432567463, 0.050152114348814274,
    0.1103696612125124,   0.2819178714479139,   0.2591681195374065,
   0.20295566550414915,   0.3323736620879069,   0.0167244127771416,
   0.25418196785296215,    0.251332659581037,   0.1366450335701835,
     0.369790836894593,   0.5098946385998686,  0.27700635228430115,
    0.7804466653674759,   0.7765870721458984,  0.11386458795215279,
  0.016257352691627366,   0.5849278801157626,   0.3090362347669837,
    0.2619924506934261,  0.32158671576383474,   0.6016049131070021,
  0.009815617625238785,   0.3854892432197202,    0.596468304092842,
   0.44346775518093884,   0.5882430664388428,   0.3861995959973342,
     1.047392774464168,  0.08754420230740816,  0.04984310632212073,
    0.0672324998303992,  0.08772656032497436,  0.04288867654437069,
   0.04456747112444238
];

my $area = [0.000013821966460524386,"",0.00038167607945955657,0.0004591385397222654,"",0.000025446515599589757,0.0005938959815914259,0.000027394937377022956,0.010084205265083024,0.0011018140741357297,0.00007450771955373174,0.00026057249737056594,0.00...

my $along_d=[0.023304990787359453,0.003418507286979303,0.049910484816558805,0.055727433460414526,0.038755696020506714,0.08690962601138932,0.07338389532453812,0.034177316475271405,0.2152996210068437,0.0778989358514991,0.034798761219127824,0.2087736743...
;
my $along_e=[[-96.92058074705261,32.838295790638604],[-96.92038500000223,32.838300500005154],[-96.92017837949813,32.837840876146984],[-96.91575185809616,32.83419391015031],[-96.91550349979606,32.83693300067325],[-96.91447049297071,32.8382918379503],[...

my $lineslice=[0.018676476695075068,0.0027402452008965525,0.03986681961739431,0.044469828362384625,0.031068128858192007,0.06935270196562665,0.05864477838054148,0.027389022501664605,0.1719473071884825,0.06242418657786493,0.027896581131503166,0.1673692...

my $lineslicealong=[0.018676476695075068,0.0027402452008965525,0.03986681961739431,0.044469828362384625,0.031068128858192007,0.06935270196562665,0.05864477838054148,0.027389022501664605,0.1719473071884825,0.06242418657786493,0.027896581131503166,0.16...

my $bufferpoint=[[-96.92206354723291,32.83681367237103,-96.91861839660037,32.83970830403321],[-96.92214354789262,32.836847672371015,-96.9186983959406,32.8397423040332],[-96.92214354789262,32.836847672371015,-96.9186983959406,32.8397423040332],[-96.92...

sub flat{
    return map { ref eq 'ARRAY' ? @$_ : $_ } @_;
}

sub assertErr( $actual, $expected, $maxErr, $description, $type='number')
	{
    if ( ! looks_like_number($actual) || ! looks_like_number($expected)) { die "$description produced NaN" };
    my $err = $type eq 'number' ? abs(($actual - $expected) / $expected) : abs( ( $actual-$expected ) / 360);
	my $msg = sprintf ( "%-30.30s a=%10.5f   e=%10.5f   ratio =%10.5f", $description, $actual, $expected, $err);
    if ($err > $maxErr) {
		warn ". err: $msg limit= $maxErr\n"
		}
	else
		{
		warn ". ok : $msg\n";
		}
}

##
my @points		= &flat ( @{ $lines } );

my $ruler		= CheapRuler->new( 32.8351 );
my $miles_ruler	= CheapRuler->new( 32.8351, 'miles');


warn "#1 distance\n";

{
my $actual = 0;

for ( my $i = 0; $i < scalar( @points ) - 1; $i++) {
	$actual += $ruler->distance( $points[$i], $points[$i + 1]);
	}

assertErr(39.636521117030824, $actual, 0.003, 'distance'); #distance within 0.3%
}

warn "#2 distance over dateline\n";

{
my $p0 = [179.9, 32.7];
my $p1 = [-179.9, 32.9];
my $actual = $ruler->distance($p0, $p1);
assertErr(29.051939213242004, $actual, 0.001, 'distance over dateline'); 
}

warn "#3 distance in miles\n";

{
    my $d = $ruler->distance([30.5, 32.8351], [30.51, 32.8451]);
    my $d2 = $miles_ruler->distance([30.5, 32.8351], [30.51, 32.8451]);

    assertErr( $d / $d2, 1.609344, 1e-12, 'distance in miles');
}

warn "#4 bearing\n";

{
    for (my $i = 0; $i < $#points; $i++) {
        my $expected = $bearing->[ $i ];
        my $actual = $ruler->bearing( $points[$i], $points[$i + 1]);
        assertErr($expected, $actual, 0.005, "bearing $i", 'degrees');
    }

}

warn "#5 bearing over dateline\n";



( run in 1.945 second using v1.01-cache-2.11-cpan-39bf76dae61 )