lib/Math/GSL.pm

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