File Coverage

blib/lib/Geo/Calc.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             # Copyrights 2011 by Sorin Alexandru Pop.
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4              
5             package Geo::Calc;
6              
7 1     1   1307 use vars '$VERSION';
  1         3  
  1         67  
8             $VERSION = '0.12';
9              
10 1     1   440 use Moose;
  0            
  0            
11             use MooseX::FollowPBP;
12             use MooseX::Method::Signatures;
13              
14             use Math::Trig qw(:pi asin acos tan deg2rad rad2deg);
15             use Math::BigFloat;
16             use Math::BigInt;
17             use Math::Units qw(convert);
18             use POSIX qw(modf fmod);
19              
20             =head1 NAME
21              
22             Geo::Calc - simple geo calculator for points and distances
23              
24             =head1 SYNOPSIS
25              
26             use Geo::Calc;
27              
28             my $gc = Geo::Calc->new( lat => 40.417875, lon => -3.710205 );
29             my $distance = $gc->distance_to( { lat => 40.422371, lon => -3.704298 }, -6 );
30             my $brng = $gc->bearing_to( { lat => 40.422371, lon => -3.704298 }, -6 );
31             my $f_brng = $gc->final_bearing_to( { lat => 40.422371, lon => -3.704298 }, -6 );
32             my $midpoint = $gc->midpoint_to( { lat => 40.422371, lon => -3.704298 }, -6 );
33             my $destination = $gc->destination_point( 90, 1, -6 );
34             my $bbox = $gc->boundry_box( 3, 4, -6 );
35             my $r_distance = $gc->rhumb_distance_to( { lat => 40.422371, lon => -3.704298 }, -6 );
36             my $r_brng = $gc->rhumb_bearing_to( { lat => 40.422371, lon => -3.704298 }, -6 );
37             my $r_destination = $gc->rhumb_destination_point( 30, 1, -6 );
38             my $point = $gc->intersection( 90, { lat => 40.422371, lon => -3.704298 }, 180, -6 );
39              
40             =head1 DESCRIPTION
41              
42             C<Geo::Calc> implements a variety of calculations for latitude/longitude points
43              
44             All these formulare are for calculations on the basis of a spherical earth
45             (ignoring ellipsoidal effects) which is accurate enough* for most purposes.
46              
47             [ In fact, the earth is very slightly ellipsoidal; using a spherical model
48             gives errors typically up to 0.3% ].
49              
50             =head1 Geo::Calc->new()
51              
52             $gc = Geo::Calc->new( lat => 40.417875, lon => -3.710205 ); # Somewhere in Madrid
53             $gc = Geo::Calc->new( lat => 51.503269, lon => 0, units => 'k-m' ); # The O2 Arena in London
54              
55             Creates a new Geo::Calc object from a latitude and longitude. The default
56             deciaml precision is -6 for all functions => meaning by default it always
57             returns the results with 6 deciamls.
58              
59             The default unit distance is 'm' (meter), but you cand define another unit using 'units'.
60             Accepted values are: 'm' (meters), 'k-m' (kilometers), 'yd' (yards), 'ft' (feet) and 'mi' (miles)
61              
62             Returns ref to a Geo::Calc object.
63              
64             =head2 Parameters
65              
66             =over 4
67              
68             =item lat
69              
70             C<>=> latitude of the point ( required )
71              
72             =item lon
73              
74             C<>=> longitude of the point ( required )
75              
76             =item radius
77              
78             C<>=> earth radius in km ( defaults to 6371 )
79              
80             =back
81              
82             =cut
83              
84             has 'lat' => (
85             is => 'ro',
86             isa => 'Num',
87             required => 1,
88             );
89              
90             has 'lon' => (
91             is => 'ro',
92             isa => 'Num',
93             required => 1,
94             );
95              
96             has 'radius' => (
97             is => 'ro',
98             isa => 'Num',
99             default => '6371',
100             );
101              
102             has 'supported_units' => (
103             is => 'ro',
104             isa => 'ArrayRef',
105             lazy => 0,
106             builder => '_build_supported_units',
107             );
108              
109             has 'units' => (
110             is => 'ro',
111             isa => 'Str',
112             lazy => 0,
113             builder => '_build_default_unit',
114             );
115              
116             sub _build_supported_units {
117             my $self = shift;
118              
119             return [ 'm', 'k-m', 'yd', 'ft', 'mi' ];
120             }
121              
122             sub _build_default_unit {
123             my $self = shift;
124              
125             if ( !defined( $self->{units} ) ) {
126             return 'm'; # Defaults to meters
127             } else { # As smartmatch does not work on 5.x < 10
128             foreach( @{ $self->get_supported_units() } ) {
129             return $_ if( $_ eq $self->{units} );
130             }
131             die sprintf( 'Unsupported unit "%s"! Supported units are: %s', $self->{units}, join(', ', @{$self->get_supported_units()} ) );
132             }
133             }
134              
135             =head1 METHODS
136              
137             =head2 distance_to
138              
139             $gc->distance_to( $point[, $precision] )
140             $gc->distance_to( { lat => 40.422371, lon => -3.704298 } )
141              
142             This uses the "haversine" formula to calculate great-circle distances between
143             the two points - that is, the shortest distance over the earth's surface -
144             giving an `as-the-crow-flies` distance between the points (ignoring any hills!)
145              
146             The haversine formula `remains particularly well-conditioned for numerical
147             computation even at small distances` - unlike calculations based on the spherical
148             law of cosines. It was published by R W Sinnott in Sky and Telescope, 1984,
149             though known about for much longer by navigators. (For the curious, c is the
150             angular distance in radians, and a is the square of half the chord length between
151             the points).
152              
153             Returns with the distance using the precision defined or -6
154             ( -6 = 6 decimals ( eg 4.000001 ) )
155              
156             =cut
157              
158             method distance_to( HashRef[Num] $point!, Int $precision? = -6 ) returns (Num) {
159             my ( $lat1, $lon1, $lat2, $lon2 ) = (
160             Math::Trig::deg2rad( $self->get_lat() ),
161             Math::Trig::deg2rad( $self->get_lon() ),
162             Math::Trig::deg2rad( $point->{lat} ),
163             Math::Trig::deg2rad( $point->{lon} ),
164             );
165              
166             my $t = sin( ($lat2 - $lat1)/2 ) ** 2 + ( cos( $lat1 ) ** 2 ) * ( sin( ( $lon2 - $lon1 )/2 ) ** 2 );
167             my $d = $self->get_radius * ( 2 * atan2( sqrt($t), sqrt(1-$t) ) );
168              
169             # Convert from kilometers to the desired distance unit
170             return $self->_precision( Math::Units::convert( $d, 'k-m', $self->get_units() ), $precision );
171             }
172              
173             =head2 bearing_to
174              
175             $gc->bearing_to( $point[, $precision] );
176             $gc->bearing_to( { lat => 40.422371, lon => -3.704298 }, -6 );
177              
178             In general, your current heading will vary as you follow a great circle path
179             (orthodrome); the final heading will differ from the initial heading by varying
180             degrees according to distance and latitude (if you were to go from say 35N,45E
181             (Baghdad) to 35N,135E (Osaka), you would start on a heading of 60 and end up on
182             a heading of 120!).
183              
184             This formula is for the initial bearing (sometimes referred to as forward
185             azimuth) which if followed in a straight line along a great-circle arc will take
186             you from the start point to the end point
187              
188             Returns the (initial) bearing from this point to the supplied point, in degrees
189             with the specified pricision
190              
191             see http://williams.best.vwh.net/avform.htm#Crs
192              
193             =cut
194              
195             method bearing_to( HashRef[Num] $point!, Int $precision? = -6 ) returns (Num) {
196             my ( $lat1, $lat2, $dlon ) = (
197             Math::Trig::deg2rad( $self->get_lat() ),
198             Math::Trig::deg2rad( $point->{lat} ),
199             Math::Trig::deg2rad( $self->get_lon() - $point->{lon} ),
200             );
201              
202             my $brng = atan2( sin( $dlon ) * cos( $lat2 ), ( cos( $lat1 ) * sin( $lat2 ) ) - ( sin( $lat1 ) * cos( $lat2 ) * cos( $dlon ) ) );
203              
204             return $self->_ib_precision( $brng, $precision, -1 );
205             }
206              
207             =head2 final_bearing_to
208              
209             my $f_brng = $gc->final_bearing_to( $point[, $precision] );
210             my $f_brng = $gc->final_bearing_to( { lat => 40.422371, lon => -3.704298 } );
211              
212             Returns final bearing arriving at supplied destination point from this point;
213             the final bearing will differ from the initial bearing by varying degrees
214             according to distance and latitude
215              
216             =cut
217              
218             method final_bearing_to( HashRef[Num] $point!, Int $precision? = -6 ) returns (Num) {
219              
220             my ( $lat1, $lat2, $dlon ) = (
221             Math::Trig::deg2rad( $point->{lat} ),
222             Math::Trig::deg2rad( $self->get_lat() ),
223             - Math::Trig::deg2rad( $point->{lon} - $self->get_lon() )
224             );
225              
226             my $brng = atan2( sin( $dlon ) * cos( $lat2 ), ( cos( $lat1 ) * sin( $lat2 ) ) - ( sin( $lat1 ) * cos( $lat2 ) * cos( $dlon ) ) );
227              
228             return $self->_fb_precision( $brng, $precision );
229             }
230              
231             =head2 midpoint_to
232              
233             $gc->midpoint_to( $point[, $precision] );
234             $gc->midpoint_to( { lat => 40.422371, lon => -3.704298 } );
235              
236             Returns the midpoint along a great circle path between the initial point and
237             the supplied point.
238              
239             see http://mathforum.org/library/drmath/view/51822.html for derivation
240              
241             =cut
242              
243             method midpoint_to( HashRef[Num] $point!, Int $precision? = -6 ) returns (HashRef[Num]) {
244             my ( $lat1, $lon1, $lat2, $dlon ) = (
245             Math::Trig::deg2rad( $self->get_lat() ),
246             Math::Trig::deg2rad( $self->get_lon() ),
247             Math::Trig::deg2rad( $point->{lat} ),
248             Math::Trig::deg2rad( $point->{lon} - $self->get_lon() ),
249             );
250              
251             my $bx = cos( $lat2 ) * cos( $dlon );
252             my $by = cos( $lat2 ) * sin( $dlon );
253              
254             my $lat3 = atan2( sin( $lat1 ) + sin ( $lat2 ), sqrt( ( ( cos( $lat1 ) + $bx ) ** 2 ) + ( $by ** 2 ) ) );
255             my $lon3 = POSIX::fmod( $lon1 + atan2( $by, cos( $lat1 ) + $bx ) + ( pi * 3 ), pi2 ) - pi;
256              
257             return {
258             lat => $self->_precision( Math::Trig::rad2deg($lat3), $precision ),
259             lon => $self->_precision( Math::Trig::rad2deg($lon3), $precision ),
260             };
261             }
262              
263             =head2 destination_point
264              
265             $gc->destination_point( $bearing, $distance[, $precision] );
266             $gc->destination_point( 90, 1 );
267              
268             Returns the destination point and the final bearing using Vincenty inverse
269             formula for ellipsoids.
270              
271             =cut
272              
273             method destination_point ( Num $brng!, Num $s!, Int $precision? = -6 ) returns (HashRef[Num]) {
274             my $lat1 = $self->get_lat();
275             my $lon1 = $self->get_lon();
276              
277             $s = Math::Units::convert( $s, $self->get_units(), 'm' );
278              
279             my $r_major = 6378137; # Equatorial Radius, WGS84
280             my $r_minor = 6356752.314245179; # defined as constant
281             my $f = 1/298.257223563; # 1/f=( $r_major - $r_minor ) / $r_major
282              
283             my $alpha1 = Math::Trig::deg2rad( $brng );
284             my $sinAlpha1 = sin( $alpha1 );
285             my $cosAlpha1 = cos( $alpha1 );
286              
287             my $tanU1 = ( 1 - $f ) * tan( Math::Trig::deg2rad( $lat1 ) );
288              
289             my $cosU1 = 1 / sqrt( (1 + $tanU1*$tanU1) );
290             my $sinU1 = $tanU1 * $cosU1;
291             my $sigma1 = atan2( $tanU1, $cosAlpha1 );
292             my $sinAlpha = $cosU1 * $sinAlpha1;
293             my $cosSqAlpha = 1 - $sinAlpha*$sinAlpha;
294              
295             my $uSq = $cosSqAlpha * ( ( $r_major * $r_major ) - ( $r_minor * $r_minor ) ) / ( $r_minor * $r_minor );
296             my $A = 1 + $uSq/16384*(4096+$uSq*(-768+$uSq*(320-175*$uSq)));
297             my $B = $uSq/1024 * (256+$uSq*(-128+$uSq*(74-47*$uSq)));
298              
299             my $sigma = $s / ($r_minor*$A);
300             my $sigmaP = pi2;
301              
302             my $cos2SigmaM = cos(2*$sigma1 + $sigma);
303             my $sinSigma = sin($sigma);
304             my $cosSigma = cos($sigma);
305              
306             while ( abs($sigma-$sigmaP) > 1e-12 ) {
307             $cos2SigmaM = cos(2*$sigma1 + $sigma);
308             $sinSigma = sin($sigma);
309             $cosSigma = cos($sigma);
310              
311             my $deltaSigma = $B*$sinSigma*($cos2SigmaM+$B/4*($cosSigma*(-1+2*$cos2SigmaM*$cos2SigmaM)-
312             $B/6*$cos2SigmaM*(-3+4*$sinSigma*$sinSigma)*(-3+4*$cos2SigmaM*$cos2SigmaM)));
313             $sigmaP = $sigma;
314             $sigma = $s / ($r_minor*$A) + $deltaSigma;
315             }
316              
317             my $tmp = $sinU1*$sinSigma - $cosU1*$cosSigma*$cosAlpha1;
318             my $lat2 = atan2( $sinU1*$cosSigma + $cosU1*$sinSigma*$cosAlpha1, (1-$f)*sqrt($sinAlpha*$sinAlpha + $tmp*$tmp) );
319              
320             my $lambda = atan2($sinSigma*$sinAlpha1, $cosU1*$cosSigma - $sinU1*$sinSigma*$cosAlpha1);
321             my $C = $f/16*$cosSqAlpha*(4+$f*(4-3*$cosSqAlpha));
322             my $L = $lambda - (1-$C) * $f * $sinAlpha * ($sigma + $C*$sinSigma*($cos2SigmaM+$C*$cosSigma*(-1+2*$cos2SigmaM*$cos2SigmaM)));
323              
324             # Normalize longitude so that its in range -PI to +PI
325             my $lon2 = POSIX::fmod( Math::Trig::deg2rad( $lon1 ) + $L + ( pi * 3 ), pi2 ) - pi;
326             my $revAz = atan2($sinAlpha, -$tmp); # final bearing, if required
327              
328             return {
329             lat => $self->_precision( Math::Trig::rad2deg($lat2), $precision ),
330             lon => $self->_precision( Math::Trig::rad2deg($lon2), $precision ),
331             final_bearing => $self->_precision( Math::Trig::rad2deg($revAz), $precision ),
332             };
333             }
334              
335             =head2 destination_point_hs
336              
337             $gc->destination_point_hs( $bearing, $distance[, $precision] );
338             $gc->destination_point_hs( 90, 1 );
339              
340             Returns the destination point from this point having travelled the given
341             distance on the given initial bearing (bearing may vary before destination is
342             reached)
343              
344             see http://williams.best.vwh.net/avform.htm#LL
345              
346             =cut
347              
348             method destination_point_hs( Num $brng!, Num $dist!, Int $precision? = -6 ) returns (HashRef[Num]) {
349             $dist = Math::Units::convert( $dist, $self->get_units(), 'k-m' );
350              
351             $dist = $dist / $self->get_radius();
352             $brng = Math::Trig::deg2rad( $brng );
353             my $lat1 = Math::Trig::deg2rad( $self->get_lat() );
354             my $lon1 = Math::Trig::deg2rad( $self->get_lon() );
355              
356             my $lat2 = asin( sin( $lat1 ) * cos( $dist ) + cos( $lat1 ) * sin( $dist ) * cos( $brng ) );
357             my $lon2 = $lon1 + atan2( sin( $brng ) * sin( $dist ) * cos( $lat1 ), cos( $dist ) - sin( $lat1 ) * sin ( $lat2 ) );
358              
359             # Normalize longitude so that its in range -PI to +PI
360             $lon2 = POSIX::fmod( Math::Trig::deg2rad( $lon2 ) + ( pi * 3 ), pi2 ) - pi;
361              
362             return {
363             lat => $self->_precision( Math::Trig::rad2deg($lat2), $precision ),
364             lon => $self->_precision( Math::Trig::rad2deg($lon2), $precision ),
365             };
366             }
367              
368             =head2 boundry_box
369              
370             $gc->boundry_box( $width[, $height[, $precision]] ); # in km
371             $gc->boundry_box( 3, 4 ); # will generate a 3x4m box around the point
372             $gc->boundry_box( 1 ); # will generate a 2x2m box around the point (radius)
373              
374             Returns the boundry box min/max having the initial point defined as the center
375             of the boundry box, given the widht and height
376              
377             =cut
378              
379             method boundry_box( Num $width!, Maybe[Num] $height?, Int $precision? = -6 ) returns (HashRef[Num]) {
380             if( !defined( $precision ) ) {
381             $width *= 2;
382             $height = $width;
383             $precision = -6;
384             } elsif( !defined( $height ) ) {
385             $width *= 2;
386             $height = $width;
387             }
388              
389             my @points = ();
390             push @points, $self->destination_point( 0, $height / 2, $precision );
391             push @points, $self->destination_point( 90, $width / 2, $precision );
392             push @points, $self->destination_point( 180, $height / 2, $precision );
393             push @points, $self->destination_point( 270, $width / 2, $precision );
394              
395             return {
396             lat_min => $points[2]->{lat},
397             lon_min => $points[3]->{lon},
398             lat_max => $points[0]->{lat},
399             lon_max => $points[1]->{lon},
400             };
401             }
402              
403             =head2 rhumb_distance_to
404              
405             $gc->rhumb_distance_to( $point[, $precision] );
406             $gc->rhumb_distance_to( { lat => 40.422371, lon => -3.704298 } );
407              
408             Returns the distance from this point to the supplied point, in km, travelling
409             along a rhumb line.
410              
411             A 'rhumb line' (or loxodrome) is a path of constant bearing, which crosses all
412             meridians at the same angle.
413              
414             Sailors used to (and sometimes still) navigate along rhumb lines since it is
415             easier to follow a constant compass bearing than to be continually adjusting
416             the bearing, as is needed to follow a great circle. Rhumb lines are straight
417             lines on a Mercator Projection map (also helpful for navigation).
418              
419             Rhumb lines are generally longer than great-circle (orthodrome) routes. For
420             instance, London to New York is 4% longer along a rhumb line than along a
421             great circle . important for aviation fuel, but not particularly to sailing
422             vessels. New York to Beijing . close to the most extreme example possible
423             (though not sailable!) . is 30% longer along a rhumb line.
424              
425             see http://williams.best.vwh.net/avform.htm#Rhumb
426              
427             =cut
428              
429             method rhumb_distance_to( HashRef[Num] $point!, Int $precision? = -6 ) returns (Num) {
430             my ( $lat1, $lat2, $dlat, $dlon ) = (
431             Math::Trig::deg2rad( $self->get_lat() ),
432             Math::Trig::deg2rad( $point->{lat} ),
433             Math::Trig::deg2rad( $point->{lat} - $self->get_lat() ),
434             abs( Math::Trig::deg2rad( $point->{lon} - $self->get_lon() ) ),
435             );
436              
437             my $dphi = log( tan( $lat2/2 + pip4 ) / tan( $lat1/2 + pip4 ) );
438             my $q = ( $dphi != 0 ) ? $dlat/$dphi : cos($lat1);# E-W line gives dPhi=0
439             $dlon = pi2 - $dlon if ( $dlon > pi );
440              
441             my $dist = sqrt( ( $dlat ** 2 ) + ( $q ** 2 ) * ( $dlon ** 2 ) ) * $self->get_radius();
442              
443             return $self->_precision( Math::Units::convert( $dist, 'k-m', $self->get_units() ), $precision );
444             }
445              
446             =head2 rhumb_bearing_to
447              
448             $gc->rhumb_bearing_to( $point[, $precision] );
449             $gc->rhumb_bearing_to( { lat => 40.422371, lon => -3.704298 } );
450              
451             Returns the bearing from this point to the supplied point along a rhumb line,
452             in degrees
453              
454             =cut
455              
456             method rhumb_bearing_to( HashRef[Num] $point!, Int $precision? = -6 ) returns (Num) {
457             my ( $lat1, $lat2, $dlon ) = (
458             Math::Trig::deg2rad( $self->get_lat() ),
459             Math::Trig::deg2rad( $point->{lat} ),
460             Math::Trig::deg2rad( $point->{lon} - $self->get_lon() ),
461             );
462              
463             my $dphi = log( tan( $lat2/2 + pip4 ) / tan( $lat1/2 + pip4 ) );
464             if( abs( $dlon ) > pi ) {
465             $dlon = ( $dlon > 0 ) ? -(pi2-$dlon) : (pi2+$dlon);
466             }
467              
468             return $self->_ib_precision( atan2( $dlon, $dphi ), $precision, 1 );
469             # return $self->_ib_precision( Math::Trig::rad2deg( atan2( $dlon, $dphi ) ), $precision );
470             }
471              
472             =head2 rhumb_destination_point
473              
474             $gc->rhumb_destination_point( $brng, $distance[, $precision] );
475             $gc->rhumb_destination_point( 30, 1 );
476              
477             Returns the destination point from this point having travelled the given distance
478             (in km) on the given bearing along a rhumb line.
479              
480             =cut
481              
482             method rhumb_destination_point( Num $brng!, Num $dist!, Int $precision? = -6 ) returns (HashRef[Num]) {
483             $dist = Math::Units::convert( $dist, $self->get_units(), 'k-m' );
484              
485             my $d = $dist / $self->get_radius();
486             my ( $lat1, $lon1 );
487             ( $lat1, $lon1 , $brng ) = (
488             Math::Trig::deg2rad( $self->get_lat() ),
489             Math::Trig::deg2rad( $self->get_lon() ),
490             Math::Trig::deg2rad( $brng ),
491             );
492              
493             my $lat2 = $lat1 + ( $d * cos( $brng ) );
494              
495             my $dlat = $lat2 - $lat1;
496             my $dphi = log( tan( $lat2/2 + pip4 ) / tan( $lat1/2 + pip4 ) );
497             my $q = ( $dphi != 0 ) ? $dlat/$dphi : cos($lat1);# E-W line gives dPhi=0
498             my $dlon = $d * sin( $brng ) / $q;
499              
500             # check for some daft bugger going past the pole
501             if ( abs( $lat2 ) > pip2 ) {
502             $lat2 = ( $lat2 > 0 ) ? pi-$lat2 : -(pi-$lat2);
503             }
504             my $lon2 = POSIX::fmod( $lon1 + $dlon + ( pi * 3 ), pi2 ) - pi;
505              
506             return {
507             lat => $self->_precision( Math::Trig::rad2deg($lat2), $precision ),
508             lon => $self->_precision( Math::Trig::rad2deg($lon2), $precision ),
509             };
510             }
511              
512              
513             =head2 intersection
514              
515             $gc->intersection( $brng1, $point, $brng2[, $precision] );
516             $gc->intersection( 90, { lat => 40.422371, lon => -3.704298 }, 180 );
517              
518             Returns the point of intersection of two paths defined by point and bearing
519              
520             see http://williams.best.vwh.net/avform.htm#Intersection
521              
522             =cut
523              
524             method intersection( Num $brng1!, HashRef[Num] $point!, Num $brng2!, Int $precision? = -6 ) returns (HashRef[Num]) {
525             my ( $lat1, $lon1, $lat2, $lon2, $brng13, $brng23 ) = (
526             Math::Trig::deg2rad( $self->get_lat() ),
527             Math::Trig::deg2rad( $self->get_lon() ),
528             Math::Trig::deg2rad( $point->{lat} ),
529             Math::Trig::deg2rad( $point->{lon} ),
530             Math::Trig::deg2rad( $brng1 ),
531             Math::Trig::deg2rad( $brng2 ),
532             );
533             my $dlat = $lat2 - $lat1;
534             my $dlon = $lon2 - $lon1;
535              
536             my $dist12 = 2 * asin( sqrt( ( sin( $dlat/2 ) ** 2 ) + cos( $lat1 ) * cos( $lat2 ) * ( sin( $dlon/2 ) ** 2 ) ) );
537             return undef if( $dist12 == 0 );
538              
539             #initial/final bearings between points
540             my $brnga = acos( ( sin( $lat2 ) - sin( $lat1 ) * cos( $dist12 ) ) / ( sin( $dist12 ) * cos( $lat1 ) ) ) || 0;
541             my $brngb = acos( ( sin( $lat1 ) - sin( $lat2 ) * cos( $dist12 ) ) / ( sin( $dist12 ) * cos( $lat2 ) ) ) || 0;
542              
543             my ( $brng12, $brng21 );
544             if( sin( $dlon ) > 0 ) {
545             $brng12 = $brnga;
546             $brng21 = pi2 - $brngb;
547             } else {
548             $brng12 = pi2 - $brnga;
549             $brng21 = $brngb;
550             }
551              
552             my $alpha1 = POSIX::fmod( $brng13 - $brng12 + ( pi * 3 ), pi2 ) - pi;
553             my $alpha2 = POSIX::fmod( $brng21 - $brng23 + ( pi * 3 ), pi2 ) - pi;
554              
555             return undef if( ( sin( $alpha1 ) == 0 ) and ( sin( $alpha2 ) == 0 ) ); #infinite intersections
556             return undef if( sin( $alpha1 ) * sin( $alpha2 ) < 0 ); #ambiguous intersection
557              
558             my $alpha3 = acos( -cos( $alpha1 ) * cos( $alpha2 ) + sin( $alpha1 ) * sin( $alpha2 ) * cos( $dist12 ) );
559             my $dist13 = atan2( sin( $dist12 ) * sin( $alpha1 ) * sin( $alpha2 ), cos( $alpha2 ) + cos( $alpha1 ) * cos( $alpha3 ) );
560             my $lat3 = asin( sin( $lat1 ) * cos( $dist13 ) + cos( $lat1 ) * sin( $dist13 ) * cos( $brng13 ) );
561             my $dlon13 = atan2( sin( $brng13 ) * sin( $dist13 ) * cos( $lat1 ), cos( $dist13 ) - sin( $lat1 ) * sin( $lat3 ) );
562             my $lon3 = POSIX::fmod( $lon1 + $dlon13 + ( pi * 3 ), pi2 ) - pi;
563              
564             return {
565             lat => $self->_precision( Math::Trig::rad2deg($lat3), $precision ),
566             lon => $self->_precision( Math::Trig::rad2deg($lon3), $precision ),
567             };
568             }
569              
570             =head2 distance_at
571              
572             Returns the distance in meters for 1deg of latitude and longitude at the
573             specified latitude
574              
575             my $m_distance = $self->distance_at([$precision]);
576             my $m_distance = $self->distance_at();
577             # at lat 2 with precision -6 returns { m_lat => 110575.625009, m_lon => 111252.098718 }
578              
579             =cut
580              
581             method distance_at(Int $precision? = -6 ) returns (HashRef[Num]) {
582             my $lat = deg2rad( $self->get_lat() );
583              
584             # Set up "Constants"
585             my $m1 = 111132.92; # latitude calculation term 1
586             my $m2 = -559.82; # latitude calculation term 2
587             my $m3 = 1.175; # latitude calculation term 3
588             my $m4 = -0.0023; # latitude calculation term 4
589             my $p1 = 111412.84; # longitude calculation term 1
590             my $p2 = -93.5; # longitude calculation term 2
591             my $p3 = 0.118; # longitude calculation term 3
592              
593             return {
594             m_lat => $self->_precision( $m1 + ($m2 * cos(2 * $lat)) + ($m3 * cos(4 * $lat)) + ( $m4 * cos(6 * $lat) ), $precision ),
595             m_lon => $self->_precision( ( $p1 * cos($lat)) + ($p2 * cos(3 * $lat)) + ($p3 * cos(5 * $lat) ), $precision ),
596             }
597             }
598              
599             sub _precision {
600             my ( $self, $number, $precision ) = @_;
601              
602             die "Error: Private method called" unless (caller)[0]->isa( ref($self) );
603              
604             my $mbf = Math::BigFloat->new( $number );
605             $mbf->precision( $precision );
606              
607             return $mbf->bstr() + 0;
608             }
609              
610             sub _ib_precision {
611             my ( $self, $brng, $precision, $mul ) = @_;
612              
613             $mul ||= 1;
614              
615             die "Error: Private method called" unless (caller)[0]->isa( ref($self) );
616              
617             my $mbf = Math::BigFloat->new( POSIX::fmod( $mul * ( Math::Trig::rad2deg( $brng ) ) + 360, 360 ) );
618             $mbf->precision( $precision );
619              
620             return $mbf->bstr() + 0;
621             }
622              
623             sub _fb_precision {
624             my ( $self, $brng, $precision ) = @_;
625              
626             die "Error: Private method called" unless (caller)[0]->isa( ref($self) );
627              
628             my $mbf = Math::BigFloat->new( POSIX::fmod( ( Math::Trig::rad2deg( $brng ) ) + 180, 360 ) );
629             $mbf->precision( $precision );
630              
631             return $mbf->bstr() + 0;
632             }
633              
634             no Moose;
635             __PACKAGE__->meta->make_immutable;
636              
637             =head1 BUGS
638              
639             All complex software has bugs lurking in it, and this module is no
640             exception.
641              
642             Please report any bugs through the web interface at L<http://rt.cpan.org>.
643              
644             =head1 AUTHOR
645              
646             Sorin Alexandru Pop C<< <asp@cpan.org> >>
647              
648             =head1 LICENSE
649              
650             This program is free software; you can redistribute it and/or
651             modify it under the same terms as Perl itself.
652              
653             See L<http://www.perl.com/perl/misc/Artistic.html>
654              
655             =cut
656              
657             __END__
658              
659             1;