view release on metacpan or  search on metacpan

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

        uint8   => 0,
        int32   => 0
    };
    $tol = {
        float16 => $tol,
        float32 => $tol,
        float64 => $tol,
        uint8   => $tol,
        int32   => $tol
    } unless ref $tol;

    Test::More::ok(@$ctx_list > 1);
    if(blessed $sym)
    {
        $sym = [($sym)x@$ctx_list];
    }
    else
    {
        Test::More::ok(@$sym == @$ctx_list);
    }
    my $output_names = $sym->[0]->list_outputs;
    my $arg_names    = $sym->[0]->list_arguments;
    my @exe_list;
    zip(sub {
        my ($s, $ctx) = @_;
        Test::More::is_deeply($s->list_arguments, $arg_names);
        Test::More::is_deeply($s->list_outputs, $output_names);
        push @exe_list, $s->simple_bind(grad_req=>$grad_req, %$ctx);
    }, $sym, $ctx_list);
    $arg_params //= {};
    $aux_params //= {};
    my %arg_dict = %{ $exe_list[0]->arg_dict };
    while(my ($n, $arr) = each %arg_dict)
    {
        if(not exists $arg_params->{$n})
        {
            $arg_params->{$n} = random(reverse @{ $arr->shape })*$scale;
        }
    }
    my %aux_dict = %{ $exe_list[0]->aux_dict };
    while(my ($n, $arr) = each %aux_dict)
    {
        if(not exists $aux_params->{$n})
        {
            $aux_params->{$n} = 0;
        }
    }
    for my $exe(@exe_list)
    {
        %arg_dict = %{ $exe->arg_dict };
        while(my ($name, $arr) = each %arg_dict)
        {
            $arr .= $arg_params->{$name};
        }
        %aux_dict = %{ $exe->aux_dict };
        while(my ($name, $arr) = each %aux_dict)
        {
            $arr .= $aux_params->{$name};
        }
    }
    my @dtypes = map { $_->outputs->[0]->dtype } @exe_list;
    my $max_idx = pdl(map { $dtypes{$_} } @dtypes)->maximum_ind;
    my $gt = $ground_truth;
    if(not defined $gt)
    {
        $gt = { %{ $exe_list[$max_idx]->output_dict } };
        if($grad_req ne 'null')
        {
            %{$gt} = (%{$gt}, %{ $exe_list[$max_idx]->grad_dict });
        }
    }

    # test
    for my $exe (@exe_list)
    {
        $exe->forward(0);
    }
    enumerate(sub {
        my ($i, $exe) = @_;
        if($i == $max_idx)
        {
            return;
        }
        zip(sub {
            my ($name, $arr) = @_;
            my $gtarr = $gt->{$name}->astype($dtypes[$i])->aspdl;
            $arr = $arr->aspdl;
            Test::More::ok(
                almost_equal(
                    $arr, $gtarr,
                    $tol->{$dtypes[$i]}
                )
            );
        }, $output_names, $exe->outputs);
    }, \@exe_list);

    # train
    if ($grad_req ne 'null')
    {
        for my $exe (@exe_list)
        {
            $exe->forward(1);
            $exe->backward($exe->outputs);
        }
        enumerate(sub {
            my ($i, $exe) = @_;
            return if($i == $max_idx);
            zip(sub {
                my ($name, $arr) = @_;
                if (not defined $gt->{$name})
                {
                    Test::More::ok(not defined $arr);
                    return;
                }
                my $gtarr = $gt->{$name}->astype($dtypes[$i])->aspdl;
                $arr = $arr->aspdl;
                Test::More::ok(
                    almost_equal(
                        $arr, $gtarr,
                        $tol->{$dtypes[$i]}
                    )
                );
            }, [@$output_names, @$arg_names], [@{ $exe->outputs }, @{ $exe->grad_arrays }]);
        }, \@exe_list);
    }
    return $gt;
}

sub zip
{
    my ($sub, @arrays) = @_;
    my $len = @{ $arrays[0] };
    for (my $i = 0; $i < $len; $i++)
    {
        $sub->(map { $_->[$i] } @arrays);
    }
}

sub enumerate
{
    my ($sub, @arrays) = @_;
    my $len = @{ $arrays[0] };
    zip($sub, [0..$len-1], @arrays);
}

sub assert
{
    my ($input, $error_str) = @_;
    local($Carp::CarpLevel) = 1;
    Carp::confess($error_str//'AssertionError')
        unless $input;
}

=head2 same_array

    Check whether two NDArrays sharing the same memory block

    Parameters
    ----------

    array1 : NDArray
        First NDArray to be checked
    array2 : NDArray
        Second NDArray to be checked

    Returns
    -------
    bool
        Whether two NDArrays share the same memory
=cut

func same_array(
    AI::MXNet::NDArray $array1,
    AI::MXNet::NDArray $array2
)
{
    $array1 += 1;
    if(not same($array1->aspdl, $array2->aspdl))
    {
        $array1 -= 1;
        return 0
    }
    $array1 -= 1;
    return same($array1->aspdl, $array2->aspdl);
}

func dies_like($code, $regexp)
{
    eval { $code->() };
    if($@ =~ $regexp)
    {
        return 1;
    }
    else
    {