File Coverage

blib/lib/Statistics/R/REXP/Vector.pm

Criterion	Covered	Total	%
statement	38	39	97.4
branch	17	20	85.0
condition	7	9	77.7
subroutine	12	12	100.0
pod	2	4	50.0
total	76	84	90.4

package Statistics::R::REXP::Vector;
# ABSTRACT: an R vector
$Statistics::R::REXP::Vector::VERSION = '1.0002';
use 5.010;

use Scalar::Util qw(blessed);

use Class::Tiny::Antlers qw(-default around);

extends 'Statistics::R::REXP';

use overload '""' => sub { shift->_to_s; };

has type => (
    is => 'ro',
    default => sub { shift->_type; },
);

has elements => (
    is => 'ro',
    default => sub { []; },
);


sub BUILDARGS {
    my $class = shift;
    if ( scalar @_ == 1 ) {
        if ( ref $_[0] eq 'HASH' ) {
            return $_[0];
        }
        elsif (blessed($_[0]) && $_[0]->isa('Statistics::R::REXP::Vector')) {
            return { elements => $_[0]->elements }
        } else {
            return { elements => $_[0] }
        }
    }
    elsif ( @_ % 2 ) {
        die "The new() method for $class expects a hash reference or a key/value list."
                . " You passed an odd number of arguments\n";
    }
    else {
        return { @_ };
    }
}


sub BUILD {
    my ($self, $args) = @_;

    die "This is an abstract class and must be subclassed" if ref($self) eq __PACKAGE__;

    # Required methods
    for my $req ( qw/_type/ ) {
        die "$req method required" unless $self->can($req);
    }

    # Required attribute type
    die "Attribute 'elements' must be an array reference" if defined $self->elements &&
        ref($self->elements) ne 'ARRAY'
}


around _eq => sub {
    my $orig = shift;

    return undef unless $orig->(@_);

    my ($self, $obj) = (shift, shift);

    Statistics::R::REXP::_compare_deeply($self->elements, $obj->elements)
};


sub _to_s {
    my $self = shift;
    my $stringify = sub { map { defined $_ ? $_ : 'undef'} @_ };
    $self->_type . '(' . join(', ', &$stringify(@{$self->elements})) . ')';
}


## Turns any references (nested lists) into a plain-old flat list.
## Lists can nest to an arbitrary level, but having references to
## anything other than arrays is not supported.
sub _flatten {
    map { ref $_ eq 'ARRAY' ? _flatten(@{$_}) : $_ } @_
}

sub is_vector {
    return 1;
}


sub to_pl {
    my $self = shift;
    [ map { (blessed $_ && $_->can('to_pl')) ?
                $_->to_pl : $_ }
          @{$self->elements} ]
}

1; # End of Statistics::R::REXP::Vector

__END__