AI-MXNet

 view release on metacpan or  search on metacpan

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

        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};
    }
    check_call(AI::MXNetCAPI::NDArraySyncCopyFromCPU($self->handle, $buf, $self->size));
    return $self;
}

=head2 aspdl

    Returns a copied PDL array of current array.

    Returns
    -------
    array : PDL
        A copy of the array content.
=cut

method aspdl()
{
    my $dtype = $self->dtype;
    my $pdl_type = PDL::Type->new(DTYPE_MX_TO_PDL->{ $dtype });
    my $pdl = PDL->new_from_specification($pdl_type, reverse @{ $self->shape });
    my $perl_pack_type = DTYPE_MX_TO_PERL->{$dtype};
    my $buf = pack("$perl_pack_type*", (0)x$self->size);
    check_call(AI::MXNetCAPI::NDArraySyncCopyToCPU($self->handle, $buf, $self->size)); 
    ## special handling for float16
    if($perl_pack_type eq 'S')
    {
        $buf = pack("f*", map { AI::MXNetCAPI::_half_to_float($_) } unpack("S*", $buf));
    }
    ${$pdl->get_dataref} = $buf;
    $pdl->upd_data;
    return $pdl;
}

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

    ----------
    $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
        NDArray, that element will be returned directly, avoid copying.

    Returns
    -------
    An NDArray in the same context as $arrays->[0]->context.
=cut

method concatenate(ArrayRef[AI::MXNet::NDArray] $arrays, Index :$axis=0, :$always_copy=1)
{
    confess("no arrays provided") unless @$arrays > 0;
    if(not $always_copy and @$arrays == 1)
    {
        return $arrays->[0];
    }
    my $shape_axis = $arrays->[0]->shape->[$axis];
    my $shape_rest1 = [@{ $arrays->[0]->shape }[0..($axis-1)]];
    my $shape_rest2 = [@{ $arrays->[0]->shape }[($axis+1)..(@{ $arrays->[0]->shape }-1)]];
    my $dtype = $arrays->[0]->dtype;
    my $i = 1;
    for my $arr (@{ $arrays }[1..(@{ $arrays }-1)])
    {
        $shape_axis += $arr->shape->[$axis];
        my $arr_shape_rest1 = [@{ $arr->shape }[0..($axis-1)]];
        my $arr_shape_rest2 = [@{ $arr->shape }[($axis+1)..(@{ $arr->shape }-1)]];
        confess("first array $arrays->[0] and $i array $arr do not match") 
            unless  join(',',@$arr_shape_rest1) eq join(',',@$shape_rest1);
        confess("first array $arrays->[0] and $i array $arr do not match") 
            unless  join(',',@$arr_shape_rest2) eq join(',',@$shape_rest2);
        confess("first array $arrays->[0] and $i array $arr dtypes do not match") 
            unless  join(',',@$arr_shape_rest2) eq join(',',@$shape_rest2);
        $i++;
    }
    my $ret_shape = [@$shape_rest1, $shape_axis, @$shape_rest2];
    my $ret = __PACKAGE__->empty($ret_shape, ctx => $arrays->[0]->context, dtype => $dtype);
    my $idx = 0;

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

{
    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;