AI-MXNet

 view release on metacpan or  search on metacpan

lib/AI/MXNet/NDArray.pm  view on Meta::CPAN

package AI::MXNet::NDArray;

=head1 NAME

    AI::MXNet::NDArray - Multidimensional tensor object of MXNet.
=cut

use strict;
use warnings;
use AI::MXNet::Base;
use AI::MXNet::NDArray::Slice;
use AI::MXNet::Context;
use Mouse;
use AI::MXNet::Function::Parameters;
use overload
    '""' => \&stringify,
    '+'  => \&add,
    '+=' => \&iadd,
    '-'  => \&subtract,
    '-=' => \&isubtract,
    '*'  => \&multiply,
    '*=' => \&imultiply,
    '/'  => \&divide,
    '/=' => \&idivide,
    '%'  => \&modulo,
    '%=' => \&imodulo,
    '**' => \&power,
    '==' => \&equal,
    '!=' => \&not_equal,
    '>'  => \&greater,
    '>=' => \&greater_equal,
    '<'  => \&lesser,
    '<=' => \&lesser_equal,
    '.=' => \&set,
    '=' => sub { $_[0] };

extends 'AI::MXNet::NDArray::Base';
has 'writable' => (is => 'rw', isa => 'Int', default => 1, lazy => 1);
has 'handle'   => (is => 'rw', isa => 'NDArrayHandle', required => 1);

sub DEMOLISH
{
    check_call(AI::MXNetCAPI::NDArrayFree(shift->handle));
}

method STORABLE_freeze($cloning)
{
    my $buf = check_call(AI::MXNetCAPI::NDArraySaveRawBytes($self->handle));
    return ($buf,\ $self->writable);
}

method STORABLE_thaw($cloning, $buf, $writable)
{
    my $handle = check_call(
                    AI::MXNetCAPI::NDArrayLoadFromRawBytes(
                        $buf, length($buf)
                    )
    );
    $self->handle($handle);
    $self->writable($$writable);
}

method at(Index @indices)
{
    confess("No idxs supplied") unless @indices;
    my $shape = $self->shape;
    my $dsize = @$shape;
    my $isize = @indices;
    confess("Dimensions size $dsize < indexes size $isize")
        if $dsize < $isize;
    confess("Dimensions size $dsize = indexes size $isize, 
                   ndarray only supports either ->at on dimension 0
                   or full crop")
        if $isize > 1 and $dsize != $isize;
    my $i = 0;
    zip(sub {
        my ($idx, $dim_size) = @_;
        confess("Dimension $i mismatch Idx: $idx >= Dim Size: $dim_size")
            if $idx >= $dim_size or ($idx + $dim_size) < 0;
        ++$i;
    }, \@indices, $shape);  
    $i = 0;
    for my $v (@indices)
    {
        $v += $shape->[$i] if $v < 0;
        ++$i;
    }
    return $self->_at($indices[0]) if @indices == 1;
    return $self->slice(@indices);
}

method slice(Slice @slices)
{
    confess("No slices supplied") unless @slices;
    my $shape = $self->shape;
    my $dsize = @$shape;
    my $isize = @slices;
    confess("Dimensions size $dsize < slices size $isize")
        if $dsize < $isize;
    confess("Dimensions size $dsize != slices size $isize,
                   ndarray only supports either ->slice on dimension 0
                   or full crop")
        if $isize > 1 and $dsize != $isize;
    my $i = -1;
    @slices = map {
        ++$i;
        ref $_ ? (@$_ == 1 ? [$_->[0], $shape->[$i] - 1] : $_) : ($_ eq 'X' ? [0, $shape->[$i] - 1] : [$_, $_]);
    } @slices;
    zip(sub {
        my ($slice, $dim_size) = @_;
        my ($begin, $end, $stride) = @$slice;
        confess("NDArray does not support slice strides != 1")
            if ($stride//0) > 1;
        confess("Dimension $i mismatch slice begin : $begin >= Dim Size: $dim_size")
            if $begin >= $dim_size or ($begin + $dim_size) < 0;
        confess("Dimension $i mismatch slice end : $end >= Dim Size: $dim_size")
            if $end >= $dim_size or ($end + $dim_size) < 0;
    }, \@slices, $shape);
    $i = 0;
    my ($begin, $end) = ([], []);
    for my $s (@slices)
    {
        $s->[0] += $shape->[$i] if $s->[0] < 0;
        $s->[1] += $shape->[$i] if $s->[1] < 0;
        confess("Dimension $i slice mismatch (begin $s->[0] > end $s->[1])")
            if($s->[0] > $s->[1]);
        push @$begin, $s->[0];
        push @$end, $s->[1] + 1;
        $i++;
    }
    return $self->_slice($begin->[0], $end->[0]) if @slices == 1;
    return AI::MXNet::NDArray::Slice->new(parent => $self, begin => $begin, end => $end);
}

method set(AcceptableInput $value, $reverse=)
{
    confess("set value must be defined") unless defined $value;
    confess("Array is not writable") if not $self->writable;
    ## plain number
    if(not ref $value)
    {
        $self->_set_value($value, { out => $self });
    }
    # ndarray
    elsif(blessed($value) and $value->isa(__PACKAGE__))
    {
        $value->copyto($self);
    }
    # slice of another ndarray
    elsif(blessed($value) and $value->isa('AI::MXNet::NDArray::Slice'))
    {
        $value->sever->copyto($self);
    }
    # perl array, PDL, PDL::Matrix
    else
    {
        $self->_sync_copyfrom($value);
    }
    return $self;
}

method asscalar()
{
    confess("ndarray size must be 1") unless $self->size == 1;
    return $self->aspdl->at(0);
}

method _sync_copyfrom(ArrayRef|PDL|PDL::Matrix $source_array)
{
    my $dtype = $self->dtype;
    my $pdl_type = PDL::Type->new(DTYPE_MX_TO_PDL->{ $dtype });
    if(not blessed($source_array))
    {
        $source_array = eval {
            pdl($pdl_type, $source_array);
        };
        confess($@) if $@;
    }
    if($pdl_type->numval != $source_array->type->numval)
    {
        my $convert_func = $pdl_type->convertfunc;
        $source_array = $source_array->$convert_func;
    }
    $source_array = pdl($pdl_type, [@{ $source_array->unpdl } ? $source_array->unpdl->[0] : 0 ]) 
        unless @{ $source_array->shape->unpdl };
    my $pdl_shape = $source_array->shape->unpdl;
    my $pdl_shape_str = join(',', ref($source_array) eq 'PDL' ? reverse @{ $pdl_shape } : @{ $pdl_shape });
    my $ndary_shape_str = join(',', @{ $self->shape });
    if($pdl_shape_str ne $ndary_shape_str)
    {
        confess("Shape inconsistant: expected $ndary_shape_str vs got $pdl_shape_str")
    }
    my $perl_pack_type = DTYPE_MX_TO_PERL->{$dtype};
    my $buf;
    ## special handling for float16
    if($perl_pack_type eq 'S')
    {
        $buf = pack("S*", map { AI::MXNetCAPI::_float_to_half($_) } unpack ("f*", ${$source_array->get_dataref}));
    }
    else
    {
        $buf = ${$source_array->get_dataref};

lib/AI/MXNet/NDArray.pm  view on Meta::CPAN

    Creates a new NDArray filled with 1, with specified shape.

    Parameters
    ----------
    $shape : Shape
        shape of the NDArray.

    :$ctx : AI::MXNet::Context, optional
        The context of the NDArray, defaults to current default context.

    :$dtype : Dtype, optional
        The dtype of the NDArray, defaults to 'float32'.

    Returns
    -------
    out: Array
        The created NDArray.
=cut

method ones(
    Shape $shape,
    AI::MXNet::Context :$ctx=AI::MXNet::Context->current_ctx,
    Dtype :$dtype='float32',
    Maybe[AI::MXNet::NDArray] :$out=
)
{
    return __PACKAGE__->_ones({ shape => $shape, ctx => "$ctx", dtype => $dtype, ($out ? (out => $out) : ()) });
}

=head2 full

    Creates a new NDArray filled with given value, with specified shape.

    Parameters
    ----------
    $shape : Shape
        shape of the NDArray.

    val : float or int
        The value to be filled with.

    :$ctx : AI::MXNet::Context, optional
        The context of the NDArray, defaults to current default context.

    :$dtype : Dtype, optional
        The dtype of the NDArray, defaults to 'float32'.

    Returns
    -------
    out: Array
        The created NDArray.
=cut

method full(
    Shape $shape, Num $val,
    AI::MXNet::Context :$ctx=AI::MXNet::Context->current_ctx,
    Dtype :$dtype='float32', Maybe[AI::MXNet::NDArray] :$out=
)
{
    return __PACKAGE__->_set_value({ src => $val, out => $out ? $out : __PACKAGE__->empty($shape, ctx => $ctx, dtype => $dtype) });
}

=head2 array

    Creates a new NDArray that is a copy of the source_array.

    Parameters
    ----------
    $source_array : AI::MXNet::NDArray PDL, PDL::Matrix, Array ref in PDL::pdl format
        Source data to create NDArray from.

    :$ctx : AI::MXNet::Context, optional
        The context of the NDArray, defaults to current default context.

    :$dtype : Dtype, optional
        The dtype of the NDArray, defaults to 'float32'.

    Returns
    -------
    out: Array
        The created NDArray.
=cut

method array(PDL|PDL::Matrix|ArrayRef|AI::MXNet::NDArray $source_array, AI::MXNet::Context :$ctx=AI::MXNet::Context->current_ctx, Dtype :$dtype='float32')
{
    if(blessed $source_array and $source_array->isa('AI::MXNet::NDArray'))
    {
        my $arr = __PACKAGE__->empty($source_array->shape, ctx => $ctx, dtype => $dtype);
        $arr .= $source_array;
        return $arr;
    }
    my $pdl_type = PDL::Type->new(DTYPE_MX_TO_PDL->{ $dtype });
    if(not blessed($source_array))
    {
        $source_array = eval {
            pdl($pdl_type, $source_array);
        };
        confess($@) if $@;
    }
    $source_array = pdl($pdl_type, [@{ $source_array->unpdl } ? $source_array->unpdl->[0] : 0 ]) unless @{ $source_array->shape->unpdl };
    my $shape = $source_array->shape->unpdl;
    my $arr = __PACKAGE__->empty([ref($source_array) eq 'PDL' ? reverse @{ $shape } : @{ $shape }], ctx => $ctx, dtype => $dtype );
    $arr .= $source_array;
    return $arr;
}


=head2 concatenate

    Concatenates an array ref of NDArrays along the first dimension.

    Parameters
    ----------
    $arrays :  array ref of NDArrays
        Arrays to be concatenate. They must have identical shape except
        for the first dimension. They also must have the same data type.
    :$axis=0 : int
        The axis along which to concatenate.
    :$always_copy=1 : bool
        Default is 1. When not 1, if the arrays only contain one

lib/AI/MXNet/NDArray.pm  view on Meta::CPAN

=head2 _new_empty_handle

    Returns a new empty handle.

    Empty handle can be used to hold result

    Returns
    -------
        a new empty ndarray handle
=cut

sub _new_empty_handle
{
    my $hdl = check_call(AI::MXNetCAPI::NDArrayCreateNone());
    return $hdl;
}

=head2 _new_alloc_handle

    Returns a new handle with specified shape and context.

    Empty handle is only used to hold results

    Returns
    -------
    a new empty ndarray handle
=cut

func _new_alloc_handle($shape, $ctx, $delay_alloc, $dtype)
{
    my $hdl = check_call(AI::MXNetCAPI::NDArrayCreateEx(
        $shape,
        scalar(@$shape),
        $ctx->device_type_id,
        $ctx->device_id,
        $delay_alloc,
        $dtype)
    );
    return $hdl;
}

=head2 waitall

    Wait for all async operations to finish in MXNet.
    This function is used for benchmarks only.
=cut

method waitall()
{
    check_call(AI::MXNetCAPI::NDArrayWaitAll());
}

=head2 _fresh_grad

        Parameters:
        ----------
        Maybe[Bool] $state=

        Whether this array's corresponding gradient array
        (registered via `autograd->mark_variables`) has been
        updated by `autograd->backward` since last reset.

        `_fresh_grad` need to be manually set to False
        after consuming gradient (usually after updating this
        array).
=cut

method _fresh_grad(Maybe[Bool] $state=)
{
    if(defined $state)
    {
        check_call(AI::MXNetCAPI::NDArraySetGradState($self->handle, $state));
        return $state;
    }
    else
    {
        return scalar(check_call(AI::MXNetCAPI::NDArrayGetGradState($self->handle)));
    }
}

=head2 detach

    Returns a new NDArray, detached from the current graph.
=cut

method detach()
{
    my $handle = check_call(AI::MXNetCAPI::NDArrayDetach($self->handle));
    return __PACKAGE__->new(handle => $handle);
}

method backward(Maybe[AI::MXNet::NDArray] $out_grad=, Bool $retain_graph=0)
{
    check_call(
        AI::MXNetCAPI::AutogradBackward(
            1,
            [$self->handle],
            [defined $out_grad ? $out_grad->handle : undef],
            $retain_graph
        )
    )
}

method CachedOp(@args) { AI::MXNet::CachedOp->new(@args) }

my $lvalue_methods = join "\n", map {"use attributes 'AI::MXNet::NDArray', \\&AI::MXNet::NDArray::$_, 'lvalue';"}
qw/at slice aspdl asmpdl reshape copy sever T astype as_in_context copyto empty zero ones full
                       array/;
eval << "EOV" if ($^V and $^V >= 5.006007);
{
  no warnings qw(misc);
  $lvalue_methods
}
EOV

__PACKAGE__->meta->make_immutable;