File Coverage

blib/lib/Math/VectorXYZ.pm

Criterion	Covered	Total	%
statement	57	62	91.9
branch	5	10	50.0
condition	2	6	33.3
subroutine	21	21	100.0
pod	0	14	0.0
total	85	113	75.2

package Math::VectorXYZ;

our $VERSION = '1.01';

use 5.006;
use strict;
use warnings;

use Carp;
use Math::Trig;

use Exporter 'import';
our @EXPORT = ('Vec');

use overload (
    '+' => 'vec_add',
    '-' => 'vec_subtract',
    '*' => 'vec_scalar_mult',
    '/' => 'vec_scalar_div',
    'x' => 'vec_cross',
    '.' => 'vec_dot',

    '=='  => 'vec_equality',
    'eq'  => 'vec_equality',
    q/""/ => 'as_string',
);

#-------------- Additional methods available beyond overloaded operators above are: -----------------
#
#   $vec->mag                Returns vector magnitude (scalar)
#   $vec->uvec               Returns a new unit vector in same direction
#   $vec->proj( $vec2 )      Returns the projection of $vec onto $vec2 (scalar)
#   $vec->angle( $vec2 )     Returns the angle between two vectors (scalar)
#
#----------------------------------------------------------------------------------------------------



#----------------------------------------- object constructors ---------------------------------------
#
# Instructions: Provide a list of three numbers (x,y,z) to the constructor
#
#----------------------------------------------------------------------------------------------------

sub new {

    my $class = shift;

    if ( @_ != 3 ) {
        croak '*** Error; syntax is "$vec = VectorXYZ->new(x,y,z)" ***';
    }

    return bless [ @_ ], $class;
}

sub Vec {

    if ( @_ != 3 ) {
        croak '*** Error; syntax is "$vec = Vec(x,y,z)" ***';
    }

    return bless [ @_ ], __PACKAGE__;
}


#----------------------------------------------------------------------------------------------------
#-------------------------------------- vector subs returning a vector ------------------------------
#----------------------------------------------------------------------------------------------------

sub vec_add {
    my ($a, $b) = @_;
    return bless [ $a->[0] + $b->[0],  $a->[1] + $b->[1],  $a->[2] + $b->[2] ], ref($a);
}

sub vec_subtract {
    my ($a, $b) = @_;
    return bless [ $a->[0] - $b->[0],  $a->[1] - $b->[1],  $a->[2] - $b->[2] ], ref($a);
}

sub vec_scalar_mult { # vec_a, const
    my ($a, $b, $swap) = @_;

    #Note: overload ('*' => 'vec_scalar_mult') magically swaps the arguments $vec * const --or-- const * $vec
    #so that the vector object is always the first argument "$a"
    return bless [ $a->[0]*$b,  $a->[1]*$b,  $a->[2]*$b ], ref($a);
}

sub vec_scalar_div { # vec_a, const
    my ($a, $b, $swap) = @_;

    #Note: overload ('/' => 'vec_scalar_div') magically swaps the arguments $vec / const --or-- const / $vec
    #so that the vector object is always the first argument "$a".
    return bless [ $a->[0] / $b,  $a->[1] / $b,  $a->[2] / $b ], ref($a);
}

sub vec_cross { # a x b per "Advanced Engineering Mathematics", Kreyszig, 7th ed.

    my ($a, $b) = @_;

    my $res = [

        $a->[1]*$b->[2] - $a->[2]*$b->[1], #i

        $a->[2]*$b->[0] - $a->[0]*$b->[2], #j

        $a->[0]*$b->[1] - $a->[1]*$b->[0], #k

    ];

    return bless $res; #cross product result is always 3d, so don't bless into ref($a)
}

sub uvec {
    my $self = shift;
    my $u_vec = ( $self / mag($self) );
    return bless $u_vec, ref($self);
}


#----------------------------------------------------------------------------------------------------
#-------------------------------------- vector subs returning a scalar ------------------------------
#----------------------------------------------------------------------------------------------------
sub vec_dot {
    my ($a, $b) = @_;
    return $a->[0]*$b->[0] + $a->[1]*$b->[1] + $a->[2]*$b->[2]; #scalar value
}

sub mag {
    my $self = shift;
    return sqrt($self.$self);
}

sub proj {
    my ($self, $b) = @_;

    unless ( $b->isa(__PACKAGE__) ) {
        croak "Argument is not a vector object";
    }

    my $p = ($self.$b) / mag($b);
    return $p;
}

sub angle {
    my ($self, $b) = @_;

    unless ( $b->isa(__PACKAGE__) ) {
        croak "Argument is not a vector object";
    }

    my $cos_theta = ($self.$b) / ( mag($self) * mag($b) );
    my $theta = acos($cos_theta);
    return rad2deg($theta);
}

my $tol = 1e-5; #floating point equality tolerance for testing
sub vec_equality {
    my ($a, $b) = @_;

    if (abs($a->[0] - $b->[0]) < $tol and
        abs($a->[1] - $b->[1]) < $tol and
        abs($a->[2] - $b->[2]) < $tol)
        { return 1 }

    else
        { return 0 }
}

sub as_string {
    my $self = shift;
    return "<" . join(",", @$self) . ">"; #
}

1;

__END__