lib/Math/GSL.pm

   1 package Math::GSL;
   2 use strict;
   3 use warnings;
   4 use Config;
   5 use Data::Dumper;
   6 use Test::More;
   7 use Scalar::Util qw/looks_like_number/;
   8 require DynaLoader;
   9 require Exporter;
  10 our @ISA = qw(Exporter DynaLoader);
  11 our @EXPORT = qw();
  12 our @EXPORT_OK = qw( is_similar );
  13 use constant MAX_DOUBLE => 1.7976931348623157e+308;
  14 use constant MIN_DOUBLE => 2.2250738585072014e-308;
  15 use constant MAX_FLOAT  => 3.40282347e+38;
  16 use constant MIN_FLOAT  => 1.175494351e-38;
  17 our $VERSION = 0.043;
  18
  19 =head1 NAME
  20
  21 Math::GSL - Perl interface to the  GNU Scientific Library (GSL) using SWIG
  22
  23 =head1 VERSION
  24
  25 Version 0.43
  26
  27 =cut
  28
  29 =head1 SYNOPSIS
  30
  31     use Math::GSL::RNG qw/:all/;
  32
  33
  34 =head1 AUTHOR
  35
  36 Jonathan Leto, C<< <jonathan@leto.net> >> and Thierry Moisan C<< <thierry.moisan@gmail.com> >>
  37
  38 =head1 BUGS
  39
  40 Please report any bugs or feature requests to the authors directly.
  41
  42
  43 =head1 SUPPORT
  44
  45 You can find documentation for this module with the perldoc command.
  46
  47     perldoc Math::GSL
  48
  49 or online at L<http://leto.net/code/Math-GSL/>
  50
  51 =over 4
  52
  53 =item * AnnoCPAN: Annotated CPAN documentation
  54
  55 L<http://annocpan.org/dist/Math::GSL>
  56
  57 =item * CPAN Ratings
  58
  59 L<http://cpanratings.perl.org/d/Math::GSL>
  60
  61 =item * Search CPAN
  62
  63 L<http://search.cpan.org/dist/Math::GSL>
  64
  65 =back
  66
  67
  68 =head1 ACKNOWLEDGEMENTS
  69
  70
  71 =head1 COPYRIGHT & LICENSE
  72
  73 Copyright 2008 Jonathan Leto, Thierry Moisan all rights reserved.
  74
  75 This program is free software; you can redistribute it and/or modify it
  76 under the same terms as Perl itself.
  77
  78 =cut
  79
  80 sub new
  81 {
  82     my ($self,$args) = @_;
  83     my $class = ref $self || $self || 'Math::GSL';
  84     my $this = { };
  85     bless $this, $class;
  86 }
  87
  88 # sync this with Build.PL's list of subsystems
  89 sub subsystems
  90 {
  91     return qw/
  92              Block Const Complex
  93              CDF Errno Fit
  94              Machine Matrix
  95              ODEIV Poly PowInt
  96              Randist Roots RNG
  97              SF Types Vector
  98     /;
  99 }
 100
 101 sub verify_results
 102 {
 103     my ($self,$results,$class, $eps) = @_;
 104     $eps ||= 1e-8;
 105     while (my($k,$v)=each %$results){
 106         my $x;
 107         if (defined $class){
 108             $x = eval qq{${class}::$k};
 109         } else {
 110             $x = eval $k;
 111         }
 112
 113         print "got $x for $k\n" if defined $ENV{DEBUG};
 114         if(defined $x && $x =~ /nan|inf/i){
 115                 ok( $v eq $x, "'$v'?='$x'" );
 116         } else {
 117             my $res = abs($x-$v);
 118             $@ ? ok(0)
 119                : ok( $res < $eps, "$k ?= $x, +- $res" );
 120         }
 121     }
 122 }
 123
 124 sub is_similar {
 125     my ($x,$y, $eps) = @_;
 126     $eps ||= 1e-8;
 127     abs($x-$y) < $eps ? 1 : 0;
 128 }
 129
 130 sub is_valid_double
 131 {
 132     my $x=shift;
 133     return 0 unless ( defined $x && looks_like_number($x) );
 134
 135     return 1 if ($x == 0);
 136
 137     $x = abs $x;
 138     (
 139       $x > MIN_DOUBLE &&
 140       $x < MAX_DOUBLE
 141     ) ? 1 : 0;
 142 }
 143 sub is_valid_float
 144 {
 145     my $x=shift;
 146     return 0 unless ( defined $x && looks_like_number($x) );
 147
 148     return 1 if ($x == 0);
 149
 150     $x = abs $x ;
 151     (
 152       $x > MIN_FLOAT &&
 153       $x < MAX_FLOAT
 154     ) ? 1 : 0;
 155 }
 156
 157 sub _has_quads          { $Config{use64bitint} eq 'define' || ($Config{longsize} >= 8) }
 158 sub _has_long_doubles                 { $Config{d_longdbl}     eq 'define'             }
 159 sub _has_long_doubles_as_default      { $Config{uselongdouble} eq 'define'             }
 160 sub _has_long_doubles_same_as_doubles { $Config{doublesize}    == $Config{longdblsize} }
 161
 162 sub _assert_dies($;$)
 163 {
 164     my ($code,$msg) = @_;
 165     my $status = eval { &$code };
 166     print "status=||$status||\n\$\?=$?\n\$\!=$!\n" if 0;
 167     $@  ?  ok(1, $msg) : ok (0, join "\n", $@,  $msg );
 168 }
 169
 170 42;