view release on metacpan or  search on metacpan

gentest/gentest_ellipsoid.pl  view on Meta::CPAN

  my $e = Geo::Ellipsoid->new( ellipsoid => $ell, angle_unit => 'degrees' );
  my $a = $e->{equatorial};
  my $b = $e->{polar};
  my $f = $e->{flattening};
  print "  e=$ell, var=$var, a=$a, b=$b, f=$f\n" if $debug;

  my $code = <<EOS;
Geo::Ellipsoid->set_defaults(angle_unit => 'degrees', ell => '$ell');
is( \$Geo::Ellipsoid::defaults{ellipsoid}, '$ell',
    'default ellipsoid is "$ell"' );
is( \$Geo::Ellipsoid::defaults{angle_unit}, 'degrees',
    'default angle unit is "degrees"' );
my $var = Geo::Ellipsoid->new();
isnt( ${var}, undef, 'object is defined' );
isa_ok( ${var}, 'Geo::Ellipsoid' );
is( ${var}->{ellipsoid}, '$ell', 'ellipsoid is "$ell"' );
is( ${var}->{angle_unit}, 'degrees', 'angle unit is "degrees"' );
delta_ok( ${var}->{equatorial}, $a,
    'equatorial radius is within tolerance' );
delta_ok( ${var}->{polar}, $b,
    'polar radius is within tolerance' );
delta_ok( ${var}->{flattening}, $f,
    'flattening is within tolerance' );
EOS
  push( @{${tests{defaults}}{code}}, $code );
  ${$tests{defaults}}{count} += 9;
}

sub test_inverse
{
  print "Generate inverse tests\n" if $debug;
  my $n = 1;
  my $lat0 = -88;
  my $latinc = 88;
  my $lon0 = 1;
  my $loninc = 89;
  $e->set_angle_unit('degrees');
  my $code = q|my $e = Geo::Ellipsoid->new(angle_unit => 'degrees');|;
  $tests{to}{code} = [ $code, 'my( $r, $a );' ];
  ${$tests{to}}{count} = 0;

  $code = <<'EOS';
my $e_pos = Geo::Ellipsoid->new(angle_unit => 'degrees');
my $e_sym = Geo::Ellipsoid->new(angle_unit => 'degrees',bearing_symmetric => 1);
my($azp,$azs);
EOS
  $tests{bearing}{code} = [ $code ];
  ${$tests{bearing}}{count} = 0;

  $code = <<'EOS';
my $e_meter = Geo::Ellipsoid->new(angle_unit => 'degrees');
my $e_kilo = Geo::Ellipsoid->new(angle_unit => 'degrees',distance => 'kilo');
my $e_mile = Geo::Ellipsoid->new(angle_unit => 'degrees',distance => 'mile');
my $e_foot = Geo::Ellipsoid->new(angle_unit => 'degrees',distance => 'foot');
my $e_nm = Geo::Ellipsoid->new(angle_unit => 'degrees',distance => 'nm');
my( $r1,$r2,$r3,$r4,$r5);
EOS
  $tests{range}{code} = [ $code ];
  ${$tests{range}}{count} = 0;

  # test endpoints: poles and equator
  for( my $lat1 = $lat0; $lat1 <= 90; $lat1 += $latinc ) {
    for( my $lon1 = $lon0; $lon1 <= 270; $lon1 += $loninc ) {
      next if abs($lat1) == 90 and $lon1 > 0;
      print "  loc1 = ($lat1,$lon1)\n" if $debug;
      for( my $lat2 = $lat0; $lat2 <= 90; $lat2 += $latinc ) {
        for( my $lon2 = $lon0; $lon2 <= 270; $lon2 += $loninc ) {
          print "  loc2 = ($lat2,$lon2)\n" if $debug;

          # skip tests where points are anti-podal
          next if $lat2 == -$lat1 and abs($lon1-$lon2) == 180;

          my( $r, $az ) = $e->to($lat1,$lon1,$lat2,$lon2);
          print "$n: ($lat1,$lon1)->($lat2,$lon2): ($r,$az)\n" if $debug;
          $n++;

          test_range($r,$lat1,$lon1,$lat2,$lon2);
          test_bearing($lat1,$lon1,$lat2,$lon2);
          test_to($r,$az,$lat1,$lon1,$lat2,$lon2);
        }
      }
    }
  }

  # test random values
  for ( 1..100 ) {
    my $lat1 = -88 + rand 176;
    my $lon1 = 1 + rand 358;
    my $lat2 = -88 + rand 176;
    my $lon2 = rand 360;

    # skip tests where points are anti-podal
    next if (abs($lat2 + $lat1) < 1) and
            (abs($lon1 - $lon2 - 180) < 1);

    my ( $r, $az ) = $e->to($lat1,$lon1,$lat2,$lon2);
    print "$n: ($lat1,$lon1)->($lat2,$lon2)\n" if $debug;
    test_range($r,$lat1,$lon1,$lat2,$lon2);
    test_bearing($lat1,$lon1,$lat2,$lon2);
    test_to($r,$az,$lat1,$lon1,$lat2,$lon2);
    $n++;
  }
}

sub test_to
{
  print "Generate to tests\n" if $debug;
  my( $range, $bearing, $lat1, $lon1, $lat2, $lon2 ) = @_;
  my $n = 1;
  my $l1 = sprintf "%.6f, %.6f", $lat1, $lon1;
  my $l2 = sprintf "%.6f, %.6f", $lat2, $lon2;

  my $t = sprintf "(\$r,\$a) = \$e->to( %.6f, %.6f, %.6f, %.6f );",
    $lat1, $lon1, $lat2, $lon2;

  my $code = "( \$r, \$a ) = \$e->to($l1,$l2);\n";
  if( $range < 100.0 ) {
    $code .= "delta_within( \$r, $range, 0.1, 'range is within tolerance' );\n";
  }else{
    $code .= "delta_ok( \$r, $range, 'range is within tolerance' );\n";
  }