File Coverage

blib/lib/Math/ErrorPropagation.pm

Criterion	Covered	Total	%
statement	104	107	97.2
branch	23	24	95.8
condition	2	6	33.3
subroutine	20	21	95.2
pod	5	16	31.2
total	154	174	88.5

package Math::ErrorPropagation;

our $VERSION = '0.01';

use 5.006;
use strict;
use warnings;
use Carp;

use overload
    '+' => \&plus,
    '-' => \&minus,
    '/' => \÷,
    '*' => \×,
    '**' => \&power,
    'exp' => \&eexp,
    'log' => \&elog,
    'sin' => \&esin,
    'cos' => \&ecos,
    'sqrt' => \&esqrt,
    '=' => \©

sub datum{
    my $caller = shift;
    my $class = ref($caller)||$caller;
    my $self = {
	var => 0.0,
	value => undef,
	@_,
    };
    return bless $self, $class;
}

sub copy{
    my $caller = shift;
    my $self = $caller->datum(%$caller);
    return $self;
}


sub central_value{
    my $self = shift;
    if(@_){$self->{value} = shift}
    return $self->{value};
}

sub sd{
    my $self = shift;
    if(@_){
	my $sd = shift;
	$self->{var} = $sd*$sd;
    }
    return sqrt($self->{var});
}

sub variance{
    my $self = shift;
    if(@_){
	$self->{var} = shift;
	croak "Given negative value $self->{var} for variance.\n"
	    if($self->{var}<0.0);
    }
    return $self->{var};
}

sub add{
    my ($caller, $x, $y) = @_;
    my $class = ref($caller)||$caller;
    return $class->datum(value=>$x->{value}+$y->{value},
		       var=>$x->{var}+$y->{var});
}


# Handles for overloaded operators:

# For the binary operators, we assume at least one argument, $x, is an object.
# If $y is a ref we assume it is also an Errdatum object;  otherwise we
# assume it is a number.

sub plus{
    my ($x,$y) = @_;
    my $class = ref($x);

    return $class->datum(value=>$x->{value}+$y->{value},
		       var=>$x->{var}+$y->{var}) if ref($y);
    return $class->datum(value=>$x->{value}+$y, var=>$x->{var});
}

sub minus{
    my ($x,$y, $swapped) = @_;
    my $class = ref($x);
    my $newvar = $x->{var};
    my $newval = $x->{value};

    if (ref($y)){
	$newval -= $y->{value} ;
	$newvar += $y->{var};
    }else{
	$newval -= $y;
	if($swapped){ $newval = -$newval;}
    }

    return $class->datum(value=>$newval, var=>$newvar);
}

sub times{
    my ($x,$y) = @_;
    my $class = ref($x);

    return $class->datum(value=>$x->{value}*$y->{value},
		       var=> $y->{value}*$y->{value}*$x->{var} +
		       $x->{value}*$x->{value}*$y->{var}) if ref($y);

    return $class->datum(value=>$x->{value}*$y, var=>$y*$y*$x->{var});
}

sub divide{
    my ($x,$y, $swapped) = @_;
    my $class = ref($x);
    my ($newvar, $newval);

    if (ref($y)){
	$newval = $x->{value}/$y->{value};
	$newvar = ($x->{var}+$newval*$newval*$y->{var})/($y->{value}*$y->{value});
    }else{
	if($swapped){
	    $newval = $y/$x->{value};
	    $newvar = ($newval*$newval*$x->{var})/($x->{value}*$x->{value});
	}else{
	    $newval = $x->{value}/$y;
	    $newvar = $x->{var}/($y*$y);
	}
    }

    return $class->datum(value=>$newval, var=>$newvar);
}

sub power{
    my ($x,$y, $swapped) = @_;
    my $class = ref($x);
    my ($newvar, $newval);

    if (ref($y)){
	$newval = $x->{value}**$y->{value};
	$newvar = $y->{value}*$newval/$x->{value};
	$newvar *= $newvar*$x->{var};
	my $otherbit = log($x->{value})*$newval;
	$newvar += $otherbit*$otherbit*$y->{var};
    }else{
	if($swapped){
	    $newval = $y**$x->{value};
	    $newvar = log($y)*$newval;
	    $newvar *= $newvar*$x->{var};
	}else{
	    $newval = $x->{value}**$y;
	    $newvar = $y*$newval/$x->{value};
	    $newvar *= $newvar*$x->{var};
	}
    }

    return $class->datum(value=>$newval, var=>$newvar);
}

sub eexp{
    my $x = shift;
    my $class = ref($x);
    my $newval = exp($x->{value});
    return $class->datum(value=>$newval,
		       var=>$x->{var}*$newval*$newval);
}

sub elog{
    my $x = shift;
    my $class = ref($x);

    return $class->datum(value=>log($x->{value}),,
		       var=>$x->{var}/($x->{value}*$x->{value}));
}

sub esin{
    my $x = shift;
    my $class = ref($x);

    my $newval = sin($x->{value});
    my $newvar = $newval*cos($x->{value});

    return $class->datum(value=>$newval,
		       var=>$x->{var}*$newvar*$newvar);
}

sub ecos{
    my $x = shift;
    my $class = ref($x);

    my $newval = cos($x->{value});
    my $newvar = $newval*sin($x->{value});

    return $class->datum(value=>$newval,
		       var=>$x->{var}*$newvar*$newvar);
}

sub esqrt{
    my $x = shift;
    my $class = ref($x);

    return $class->datum(value=>sqrt($x->{value}),
		       var=>$x->{var}/(4.0*$x->{value}));

}


1;

__END__