File Coverage

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

Criterion	Covered	Total	%
statement	32	32	100.0
branch	9	10	90.0
condition	4	9	44.4
subroutine	10	10	100.0
pod	0	2	0.0
total	55	63	87.3

package Statistics::R::REXP::Complex;
# ABSTRACT: an R numeric vector
$Statistics::R::REXP::Complex::VERSION = '1.0';
use 5.010;

use Scalar::Util qw(blessed looks_like_number);
use Math::Complex qw();

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

extends 'Statistics::R::REXP::Vector';
use overload;


use constant sexptype => 'CPLXSXP';


sub BUILDARGS {
    my $class = shift;
    my $attributes = $class->SUPER::BUILDARGS(@_);

    if (ref($attributes->{elements}) eq 'ARRAY') {
        $attributes->{elements} = [
            map { (blessed($_) && $_->isa('Math::Complex')) ? $_ :
                      looks_like_number $_ ? Math::Complex::cplx($_) :
                          undef }
                Statistics::R::REXP::Vector::_flatten(@{$attributes->{elements}})
        ]
    }
    $attributes
}


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

    # Required attribute type
    die "Elements of the 'elements' attribute must be scalar numbers or instances of Math::Complex" if
        defined $self->elements &&
        grep { defined($_) && !(blessed($_) && $_->isa('Math::Complex') ||
                   Scalar::Util::looks_like_number($_)) }
             @{$self->elements}
}


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

    return unless Statistics::R::REXP::_eq(@_);

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

    my $a = $self->elements;
    my $b = $obj->elements;
    return undef unless scalar(@$a) == scalar(@$b);
    for (my $i = 0; $i < scalar(@{$a}); $i++) {
        my $x = $a->[$i];
        my $y = $b->[$i];
        if (defined($x) && defined($y)) {
            return undef unless
                $x == $y;
        } else {
            return undef if defined($x) or defined($y);
        }
    }

    1
};


sub _type { 'complex'; }


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

__END__