Geo-Inverse-0.05/0000755000076400007640000000000010605744442013127 5ustar mdavismdavisGeo-Inverse-0.05/README0000644000076400007640000000014710521410632013775 0ustar mdavismdavisIf you have any comments I'd love to hear from you. Thanks, Mike (mrdvt92) qw/perl michaelrdavis com/ Geo-Inverse-0.05/MANIFEST0000644000076400007640000000012110534226317014247 0ustar mdavismdavisCHANGES LICENSE Makefile.PL MANIFEST META.yml README lib/Geo/Inverse.pm t/base.t Geo-Inverse-0.05/Makefile.PL0000644000076400007640000000100610536427332015075 0ustar mdavismdavisuse ExtUtils::MakeMaker; WriteMakefile( NAME => q{Geo::Inverse}, VERSION_FROM => q{lib/Geo/Inverse.pm}, PREREQ_PM => { strict => 0, vars => 0, Geo::Constants => 0.04, Geo::Functions => 0.03, Geo::Ellipsoids => 0.09, }, ($] >= 5.005 ? ( ABSTRACT_FROM => 'lib/Geo/Inverse.pm', ) : () ), ); Geo-Inverse-0.05/lib/0000755000076400007640000000000010605744442013675 5ustar mdavismdavisGeo-Inverse-0.05/lib/Geo/0000755000076400007640000000000010605744442014407 5ustar mdavismdavisGeo-Inverse-0.05/lib/Geo/Inverse.pm0000644000076400007640000001276310605602454016365 0ustar mdavismdavispackage Geo::Inverse; =head1 NAME Geo::Inverse - Calculate geographic distance from a lat & lon pair. =head1 SYNOPSIS use Geo::Inverse; my $obj = Geo::Inverse->new(); # default "WGS84" my ($lat1,$lon1,$lat2,$lon2)=(38.87, -77.05, 38.95, -77.23); my ($faz, $baz, $dist)=$obj->inverse($lat1,$lon1,$lat2,$lon2); #array context my $dist=$obj->inverse($lat1,$lon1,$lat2,$lon2); #scalar context print "Input Lat: $lat1 Lon: $lon1\n"; print "Input Lat: $lat2 Lon: $lon2\n"; print "Output Distance: $dist\n"; print "Output Forward Azimuth: $faz\n"; print "Output Back Azimuth: $baz\n"; =head1 DESCRIPTION This module is a pure Perl port of the NGS program in the public domain "inverse" by Robert (Sid) Safford and Stephen J. Frakes. =cut use strict; use vars qw($VERSION); use Geo::Constants qw{PI}; use Geo::Functions qw{rad_deg deg_rad}; $VERSION = sprintf("%d.%02d", q{Revision: 0.05} =~ /(\d+)\.(\d+)/); =head1 CONSTRUCTOR =head2 new The new() constructor may be called with any parameter that is appropriate to the ellipsoid method which establishes the ellipsoid. my $obj = Geo::Inverse->new(); # default "WGS84" =cut sub new { my $this = shift(); my $class = ref($this) || $this; my $self = {}; bless $self, $class; $self->initialize(@_); return $self; } =head1 METHODS =cut sub initialize { my $self = shift(); my $param = shift()||undef(); $self->ellipsoid($param); } =head2 ellipsoid Method to set or retrieve the current ellipsoid object. The ellipsoid is a Geo::Ellipsoids object. my $ellipsoid=$obj->ellipsoid; #Default is WGS84 $obj->ellipsoid('Clarke 1866'); #Built in ellipsoids from Geo::Ellipsoids $obj->ellipsoid({a=>1}); #Custom Sphere 1 unit radius =cut sub ellipsoid { my $self = shift(); if (@_) { my $param=shift(); use Geo::Ellipsoids; my $obj=Geo::Ellipsoids->new($param); $self->{'ellipsoid'}=$obj; } return $self->{'ellipsoid'}; } =head2 inverse This method is the user frontend to the mathematics. This interface will not change in future versions. my ($faz, $baz, $dist)=$obj->inverse($lat1,$lon1,$lat2,$lon2); =cut sub inverse { my $self=shift(); my $lat1=shift(); #degrees my $lon1=shift(); #degrees my $lat2=shift(); #degrees my $lon2=shift(); #degrees my ($faz, $baz, $dist)=$self->_inverse(rad_deg($lat1), rad_deg($lon1), rad_deg($lat2), rad_deg($lon2)); return wantarray ? (deg_rad($faz), deg_rad($baz), $dist) : $dist; } ######################################################################## # # This function was copied from Geo::Ellipsoid # Copyright 2005-2006 Jim Gibson, all rights reserved. # # This program is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # # internal functions # # inverse # # Calculate the displacement from origin to destination. # The input to this subroutine is # ( latitude-1, longitude-1, latitude-2, longitude-2 ) in radians. # # Return the results as the list (range,bearing) with range in meters # and bearing in radians. # ######################################################################## sub _inverse { my $self = shift; my( $lat1, $lon1, $lat2, $lon2 ) = (@_); my $ellipsoid=$self->ellipsoid; my $a = $ellipsoid->a; my $f = $ellipsoid->f; my $eps = 1.0e-23; my $max_loop_count = 20; my $pi=PI; my $twopi = 2 * $pi; my $r = 1.0 - $f; my $tu1 = $r * sin($lat1) / cos($lat1); my $tu2 = $r * sin($lat2) / cos($lat2); my $cu1 = 1.0 / ( sqrt(($tu1*$tu1) + 1.0) ); my $su1 = $cu1 * $tu1; my $cu2 = 1.0 / ( sqrt( ($tu2*$tu2) + 1.0 )); my $s = $cu1 * $cu2; my $baz = $s * $tu2; my $faz = $baz * $tu1; my $dlon = $lon2 - $lon1; my $x = $dlon; my $cnt = 0; my( $c2a, $c, $cx, $cy, $cz, $d, $del, $e, $sx, $sy, $y ); do { $sx = sin($x); $cx = cos($x); $tu1 = $cu2*$sx; $tu2 = $baz - ($su1*$cu2*$cx); $sy = sqrt( $tu1*$tu1 + $tu2*$tu2 ); $cy = $s*$cx + $faz; $y = atan2($sy,$cy); my $sa; if( $sy == 0.0 ) { $sa = 1.0; }else{ $sa = ($s*$sx) / $sy; } $c2a = 1.0 - ($sa*$sa); $cz = $faz + $faz; if( $c2a > 0.0 ) { $cz = ((-$cz)/$c2a) + $cy; } $e = ( 2.0 * $cz * $cz ) - 1.0; $c = ( ((( (-3.0 * $c2a) + 4.0)*$f) + 4.0) * $c2a * $f )/16.0; $d = $x; $x = ( ($e * $cy * $c + $cz) * $sy * $c + $y) * $sa; $x = ( 1.0 - $c ) * $x * $f + $dlon; $del = $d - $x; } while( (abs($del) > $eps) && ( ++$cnt <= $max_loop_count ) ); $faz = atan2($tu1,$tu2); $baz = atan2($cu1*$sx,($baz*$cx - $su1*$cu2)) + $pi; $x = sqrt( ((1.0/($r*$r)) -1.0 ) * $c2a+1.0 ) + 1.0; $x = ($x-2.0)/$x; $c = 1.0 - $x; $c = (($x*$x)/4.0 + 1.0)/$c; $d = ((0.375*$x*$x) - 1.0)*$x; $x = $e*$cy; $s = 1.0 - $e - $e; $s = (((((((( $sy * $sy * 4.0 ) - 3.0) * $s * $cz * $d/6.0) - $x) * $d /4.0) + $cz) * $sy * $d) + $y ) * $c * $a * $r; # adjust azimuth to (0,360) $faz += $twopi if $faz < 0; return($faz, $baz, $s); } 1; __END__ =head1 TODO Add more tests. =head1 BUGS Please send to the geo-perl email list. =head1 LIMITS No guarantees that Perl handles all of the double precision calculations in the same manner as Fortran. =head1 AUTHOR Michael R. Davis qw/perl michaelrdavis com/ =head1 LICENSE Copyright (c) 2006 Michael R. Davis (mrdvt92) This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO Net::GPSD Geo::Ellipsoid GIS::Distance::GeoEllipsoid Geo-Inverse-0.05/LICENSE0000644000076400007640000000026010521410632014116 0ustar mdavismdavisCopyright (c) 2006 Michael R. Davis (mrdvt92) All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Geo-Inverse-0.05/META.yml0000664000076400007640000000076410605744442014411 0ustar mdavismdavis# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Geo-Inverse version: 0.05 version_from: lib/Geo/Inverse.pm installdirs: site requires: Geo::Constants: 0.04 Geo::Ellipsoids: 0.09 Geo::Functions: 0.03 strict: 0 vars: 0 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.30 Geo-Inverse-0.05/CHANGES0000644000076400007640000000043610605602574014124 0ustar mdavismdavis2007-04-06 v0.04 * Added scalar context to inverse function should be 100% backward compatable 2006-12-08 v0.03 * Merged set and ellipsoid methods * Update build requirment versions 2006-12-03 v0.02 * Imported Geo::Constants Geo::Functions 2006-10-30 v0.01 * Original version Geo-Inverse-0.05/t/0000755000076400007640000000000010605744442013372 5ustar mdavismdavisGeo-Inverse-0.05/t/base.t0000755000076400007640000000305110605744430014470 0ustar mdavismdavis#!/usr/bin/perl -w # -*- perl -*- # # $Id: base.t,v 0.1 2006/02/21 eserte Exp $ # Author: Michael R. Davis # =head1 Test Examples base.t - Good examples concerning how to use this module =cut use strict; use lib q{lib}; use lib q{../lib}; use constant NEAR_DEFAULT => 7; sub near { my $x=shift(); my $y=shift(); my $p=shift()||NEAR_DEFAULT; if (($x-$y)/$y < 10**-$p) { return 1; } else { return 0; } } BEGIN { if (!eval q{ use Test; 1; }) { print "1..0 # tests only works with installed Test module\n"; exit; } } sub d { my ($d,$m,$s)=@_; return($d + ($m + $s/60)/60); } BEGIN { plan tests => 12 } # just check that all modules can be compiled ok(eval {require Geo::Inverse; 1}, 1, $@); my $o = Geo::Inverse->new(); ok(ref $o, "Geo::Inverse"); my ($faz, $baz, $dist)=$o->inverse(34.5,-77.5,35,-78); ok near($faz, d(320,36,23.2945)); ok near($baz, d(140,19,17.2861)); ok near($dist, 71921.4677); ($faz, $baz, $dist)=$o->inverse(34.5,-77.5,d(34,11,11),-1*d(77,45,45)); ok near($faz, d(214,50,44.6531)); ok near($baz, d(34,41,51.5299)); ok near($dist, 42350.9312); ($faz, $baz, $dist) = $o->inverse(d(qw{67 34 54.65443}),-1*d(qw{118 23 54.24523}), d(qw{67 45 32.65433}),-1*d(qw{118 34 43.23454})); ok near($faz, d(qw{338 56 3.2089})); ok near($baz, d(qw{158 46 2.8840})); ok near($dist, 21193.2643); #New in Geo::Inverse->VERISON >= 0.05 $dist = $o->inverse(d(qw{67 34 54.65443}),-1*d(qw{118 23 54.24523}), d(qw{67 45 32.65433}),-1*d(qw{118 34 43.23454})); ok near($dist, 21193.2643);