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.042;
  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.01
  26
  27 =cut
  28
  29 =head1 SYNOPSIS
  30
  31
  32     use Math::GSL::Sf qw/ ... /;
  33     ...
  34
  35 =head1 EXPORT
  36
  37
  38
  39 =head1 AUTHOR
  40
  41 Jonathan Leto, C<< <jonathan at leto.net> >>
  42
  43 =head1 BUGS
  44
  45 Please report any bugs or feature requests to C<bug-math-gsl at rt.cpan.org>, or through
  46 the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Math::GSL>.  I will be notified, and then you'll
  47 automatically be notified of progress on your bug as I make changes.
  48
  49
  50 =head1 SUPPORT
  51
  52 You can find documentation for this module with the perldoc command.
  53
  54     perldoc Math::GSL
  55
  56 or online at L<http://leto.net/code/Math-GSL/>
  57
  58
  59 You can also look for information at:
  60
  61 =over 4
  62
  63 =item * RT: CPAN's request tracker
  64
  65 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Math::GSL>
  66
  67 =item * AnnoCPAN: Annotated CPAN documentation
  68
  69 L<http://annocpan.org/dist/Math::GSL>
  70
  71 =item * CPAN Ratings
  72
  73 L<http://cpanratings.perl.org/d/Math::GSL>
  74
  75 =item * Search CPAN
  76
  77 L<http://search.cpan.org/dist/Math::GSL>
  78
  79 =back
  80
  81
  82 =head1 ACKNOWLEDGEMENTS
  83
  84
  85 =head1 COPYRIGHT & LICENSE
  86
  87 Copyright 2008 Jonathan Leto, all rights reserved.
  88
  89 This program is free software; you can redistribute it and/or modify it
  90 under the same terms as Perl itself.
  91
  92 =cut
  93
  94 sub new
  95 {
  96     my ($self,$args) = @_;
  97     my $class = ref $self || $self || 'Math::GSL';
  98     my $this = { };
  99     bless $this, $class;
 100 }
 101
 102 sub subsystems
 103 {
 104     return qw/
 105              CDF Errno Fit Machine
 106              Poly PowInt Randist SF Types
 107     /;
 108 }
 109
 110 sub verify_results
 111 {
 112     my ($self,$results,$class, $eps) = @_;
 113     $eps ||= 1e-8;
 114     while (my($k,$v)=each %$results){
 115         my $x;
 116         if (defined $class){
 117             $x = eval qq{${class}::$k};
 118         } else {
 119             $x = eval $k;
 120         }
 121
 122         print "got $x for $k\n" if defined $ENV{DEBUG};
 123         if(defined $x && $x =~ /nan|inf/i){
 124                 ok( $v eq $x, "'$v'?='$x'" );
 125         } else {
 126             my $res = abs($x-$v);
 127             $@ ? ok(0)
 128                : ok( $res < $eps, "$k ?= $x, +- $res" );
 129         }
 130     }
 131 }
 132
 133 sub is_similar {
 134     my ($x,$y, $eps) = @_;
 135     $eps ||= 1e-8;
 136     abs($x-$y) < $eps ? 1 : 0;
 137 }
 138
 139 sub is_valid_double
 140 {
 141     my $x=shift;
 142     return 0 unless ( defined $x && looks_like_number($x) );
 143
 144     return 1 if ($x == 0);
 145
 146     $x = abs $x;
 147     (
 148       $x > MIN_DOUBLE &&
 149       $x < MAX_DOUBLE
 150     ) ? 1 : 0;
 151 }
 152 sub is_valid_float
 153 {
 154     my $x=shift;
 155     return 0 unless ( defined $x && looks_like_number($x) );
 156
 157     return 1 if ($x == 0);
 158
 159     $x = abs $x ;
 160     (
 161       $x > MIN_FLOAT &&
 162       $x < MAX_FLOAT
 163     ) ? 1 : 0;
 164 }
 165
 166 sub _has_quads          { $Config{use64bitint} eq 'define' || ($Config{longsize} >= 8) }
 167 sub _has_long_doubles                 { $Config{d_longdbl}     eq 'define'             }
 168 sub _has_long_doubles_as_default      { $Config{uselongdouble} eq 'define'             }
 169 sub _has_long_doubles_same_as_doubles { $Config{doublesize}    == $Config{longdblsize} }
 170
 171 sub _assert_dies($;$)
 172 {
 173     my ($code,$msg) = @_;
 174     my $status = eval { &$code };
 175     print "status=||$status||\n\$\?=$?\n\$\!=$!\n" if 0;
 176     $@  ?  ok(1, $msg) : ok (0, join "\n", $@,  $msg );
 177 }
 178
 179 42;