File Coverage

blib/lib/Math/Random/Brownian.pm

Criterion	Covered	Total	%
statement	21	119	17.6
branch	0	20	0.0
condition			n/a
subroutine	7	15	46.6
pod	0	5	0.0
total	28	159	17.6

package Math::Random::Brownian;

use 5.008005;
use strict;
use warnings;
use Carp;

require Exporter;
use AutoLoader;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Math::Random::Brownian ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);

our $VERSION = '0.03';
sub AUTOLOAD {
    # This AUTOLOAD is used to 'autoload' constants from the constant()
    # XS function.

    my $constname;
    our $AUTOLOAD;
    ($constname = $AUTOLOAD) =~ s/.*:://;
    croak "&Math::Random::Brownian::constant not defined" if $constname eq 'constant';
    my ($error, $val) = constant($constname);
    if ($error) { croak $error; }
    {
        no strict 'refs';
        # Fixed between 5.005_53 and 5.005_61
#XXX    if ($] >= 5.00561) {
#XXX        *$AUTOLOAD = sub () { $val };
#XXX    }
#XXX    else {
            *$AUTOLOAD = sub { $val };
#XXX    }
    }
    goto &$AUTOLOAD;
}

require XSLoader;
XSLoader::load('Math::Random::Brownian', $VERSION);
use Params::Validate qw( validate SCALAR );

my $Validate =
    {
     LENGTH   => {type => SCALAR,
                  callbacks =>
                  {
                   'is positive' =>
                   sub{ $_[0] > 0},
                   'is an integer' =>
                   sub{ $_[0] == int $_[0]},
                  },
                 },
     HURST    => {type => SCALAR,
                  callbacks =>
                  {
                   'is between 0 and 1' =>
                   sub{ $_[0] > 0 && $_[0] < 1},
                  },
                 },
     VARIANCE => {type => SCALAR,
                  callbacks =>
                  {
                   'is positive' =>
                   sub{ $_[0] > 0 },
                  },
                 },
     NOISE    => {type => SCALAR,
                  callbacks =>
                  {
                   'must be Gaussian or Brownian' =>
                   sub{ $_[0] =~ 'Gaussian' || $_[0] =~ 'Brownian' },
                  },
                 },
   };

 my $Wavelet_Validate =
   {
    %$Validate,
    APPROX_PARAM => {type => SCALAR,
                      callbacks =>
                      {
                       'is an integer' =>
                       sub{ $_[0] == int $_[0] },
                      },
                     },

    };

# Preloaded methods go here.
sub new
{
 my $class = shift;

 my $self = {};

 $self->{SEED1} = time ^ ($$ + ($$ << 15));
 $self->{SEED2} = time ^ $$ ^ unpack "%L*", `ps axww | gzip`;

 bless $self, $class;

 return $self;
}

sub Hosking
{
 my $self = shift;
 my %p = ();
 %p = validate(@_,$Validate);

 my $n = int (log($p{LENGTH})/log(2.0)) + 1;
 my $H = $p{HURST};
 my $L = $p{VARIANCE};
 my $cum;
 if( $p{NOISE} =~ 'Gaussian' ) { $cum = 0; }
 if( $p{NOISE} =~ 'Brownian' ) { $cum = 1; }
 my $seed1 = $self->{SEED1};
 my $seed2 = $self->{SEED2};

 my $output = __hosking($n,$H,$L,$cum,$seed1,$seed2);

 # Save new seeds
 $self->{SEED1} = $$output[-2];
 $self->{SEED2} = $$output[-1];

 # Truncate the array
 my @new_output = ();
 for(my $i=0;$i<$p{LENGTH};$i++)
 {
  $new_output[$i] = $$output[$i];
 }

 return @new_output;
}

sub Circulant
{
 my $self = shift;
 my %p = ();
 %p = validate(@_,$Validate);

 my $n = int (log($p{LENGTH})/log(2.0)) + 1;
 my $H = $p{HURST};
 my $L = $p{VARIANCE};
 my $cum;
 if( $p{NOISE} =~ 'Gaussian' ) { $cum = 0; }
 if( $p{NOISE} =~ 'Brownian' ) { $cum = 1; }
 my $seed1 = $self->{SEED1};
 my $seed2 = $self->{SEED2};

 my $output = __circulant($n,$H,$L,$cum,$seed1,$seed2);

 # Save new seeds
 $self->{SEED1} = $$output[-2];
 $self->{SEED2} = $$output[-1];

 # Truncate the array
 my @new_output = ();
 for(my $i=0;$i<$p{LENGTH};$i++)
 {
  $new_output[$i] = $$output[$i];
 }

 return @new_output;
}

sub ApprCirc
{
 my $self = shift;
 my %p = ();
 %p = validate(@_,$Validate);

 my $n = int (log($p{LENGTH})/log(2.0)) + 1;
 my $H = $p{HURST};
 my $L = $p{VARIANCE};
 my $cum;
 if( $p{NOISE} =~ 'Gaussian' ) { $cum = 0; }
 if( $p{NOISE} =~ 'Brownian' ) { $cum = 1; }
 my $seed1 = $self->{SEED1};
 my $seed2 = $self->{SEED2};

 my $output = __apprcirc($n,$H,$L,$cum,$seed1,$seed2);

 # Save new seeds
 $self->{SEED1} = $$output[-2];
 $self->{SEED2} = $$output[-1];

 # Truncate the array
 my @new_output = ();
 for(my $i=0;$i<$p{LENGTH};$i++)
 {
  $new_output[$i] = $$output[$i];
 }

 return @new_output;
}

sub Paxson
{
 my $self = shift;
 my %p = ();
 %p = validate(@_,$Validate);

 my $n = int (log($p{LENGTH})/log(2.0)) + 1;
 my $H = $p{HURST};
 my $L = $p{VARIANCE};
 my $cum;
 if( $p{NOISE} =~ 'Gaussian' ) { $cum = 0; }
 if( $p{NOISE} =~ 'Brownian' ) { $cum = 1; }
 my $seed1 = $self->{SEED1};
 my $seed2 = $self->{SEED2};

 my $output = __paxson($n,$H,$L,$cum,$seed1,$seed2);

 # Save new seeds
 $self->{SEED1} = $$output[-2];
 $self->{SEED2} = $$output[-1];

 # Truncate the array
 my @new_output = ();
 for(my $i=0;$i<$p{LENGTH};$i++)
 {
  $new_output[$i] = $$output[$i];
 }

 return @new_output;
}

sub DESTROY
{
 my $self = shift;
}


1;
__END__