AI-MXNet

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

Revision history for Perl extension AI::MXNet

1.0102 Sun Aug  6 16:55:08 PDT 2017
        - bugfixes in Image.pm, updated tests, added PearsonCorrelation metric, added Convolutional RNN modules.

1.0101  Sun Jul  2 17:16:01 PDT 2017
        - reworked CachedOp, two new optimizers, auto module reshape, using strings to index the kvstore.

1.01    Sat Jun 10 23:57:27 PDT 2017
        - sync with python.

0.9507  Thu May 11 17:04:44 PDT 2017
        - added AutoGrad, bugfixes.

0.9506  Sat Apr 29 20:26:50 PDT 2017
        - Ftrl optimizer, new tests, bugfixes.

0.9505  Sun Apr 23 21:26:04 PDT 2017
        - Perplexity bugfix, two new examples.

0.9504  Wed Apr 19 18:59:45 PDT 2017
        - LR Scheduler bugfix.

0.9503  Wed Apr 19 13:33:57 PDT 2017
        - added an example of generation of inferred text via pre-trained RNN.
        - bugfixes/tests.

0.9502  Sat Apr 15 17:18:21 PDT 2017
        - optimizations/bugfixes.

0.9501  Sat Apr  8 13:01:00 PDT 2017
        - ZoneoutCell, nd inferred reshape and moveaxis, cosmetic changes to Image iter,
           pod reworked to be readable via metacpan.

0.95  Sun Mar 26 17:42:02 PDT 2017
        - docs, bugfixes, tests in order to be visible on http://mxnet.io

0.03  Tue Feb 14 07:28:11 PST 2017
        - sync up with current state of the Python inteface.
        - high level RNN support.

0.02  Tue Feb 14 07:28:11 PST 2017
        - prepared for inclusion to the mxnet code repository.

MANIFEST  view on Meta::CPAN

META.yml
MANIFEST
examples/calculator.pl
examples/plot_network.pl
examples/char_lstm.pl
examples/get_ptb_data.sh
examples/lstm_bucketing.pl
examples/mnist.pl
examples/cudnn_lstm_bucketing.pl
Makefile.PL
Changes
META.json
t/test_recordio.t
t/test_random.t
t/test_init.t
t/test_model_parallel.t
t/test_optimizers.t
t/test_multi_device_exec.t
t/test_ndarray.t
t/test_io.t
t/AI-MXNet.t
t/test_kvstore.t
t/test_attr.t
t/test_module.t
t/test_symbol.t
t/test_conv.t
t/test_viz.t
t/test_rnn.t
t/test_io_image.t
t/test_executor.t
t/test_infer_shape.t
lib/AI/MXNet.pm
lib/AI/MXNet/Random.pm
lib/AI/MXNet/CachedOp.pm
lib/AI/MXNet/Context.pm
lib/AI/MXNet/Contrib/AutoGrad.pm
lib/AI/MXNet/Contrib/Symbol.pm
lib/AI/MXNet/Contrib/NDArray.pm
lib/AI/MXNet/Profiler.pm
lib/AI/MXNet/Module.pm
lib/AI/MXNet/Monitor.pm
lib/AI/MXNet/Function/Parameters.pm
lib/AI/MXNet/Initializer.pm
lib/AI/MXNet/Types.pm
lib/AI/MXNet/Util/Printable.pm
lib/AI/MXNet/Rtc.pm
lib/AI/MXNet/RNN.pm
lib/AI/MXNet/Executor.pm
lib/AI/MXNet/Visualization.pm
lib/AI/MXNet/Optimizer.pm
lib/AI/MXNet/Contrib.pm
lib/AI/MXNet/Image.pm
lib/AI/MXNet/Symbol/AttrScope.pm
lib/AI/MXNet/Symbol/Doc.pm
lib/AI/MXNet/Symbol/Base.pm
lib/AI/MXNet/Symbol/NameManager.pm
lib/AI/MXNet/KVStoreServer.pm
lib/AI/MXNet/KVStore.pm
lib/AI/MXNet/RecordIO.pm
lib/AI/MXNet/Base.pm
lib/AI/MXNet/NDArray/Slice.pm
lib/AI/MXNet/NDArray/Doc.pm
lib/AI/MXNet/NDArray/Base.pm
lib/AI/MXNet/Symbol.pm
lib/AI/MXNet/Metric.pm
lib/AI/MXNet/Executor/Group.pm
lib/AI/MXNet/NDArray.pm
lib/AI/MXNet/RNN/Cell.pm
lib/AI/MXNet/RNN/IO.pm
lib/AI/MXNet/LRScheduler.pm
lib/AI/MXNet/Callback.pm
lib/AI/MXNet/IO.pm
lib/AI/MXNet/Module/Bucketing.pm
lib/AI/MXNet/Module/Base.pm
lib/AI/MXNet/TestUtils.pm
lib/AI/MXNet/Logging.pm
README

META.json  view on Meta::CPAN

{
   "abstract" : "Perl interface to MXNet machine learning library",
   "author" : [
      "Sergey Kolychev <sergeykolychev.github@gmail.com>"
   ],
   "dynamic_config" : 0,
   "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.143240",
   "license" : [
      "apache_2_0"
   ],
   "meta-spec" : {
      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
      "version" : "2"
   },
   "name" : "AI-MXNet",
   "no_index" : {
      "directory" : [
         "t",
         "inc"
      ]
   },
   "prereqs" : {
      "build" : {
         "requires" : {}
      },
      "configure" : {
         "requires" : {
            "ExtUtils::MakeMaker" : "6.30"
         }
      },
      "runtime" : {
         "requires" : {
            "AI::MXNetCAPI" : "1.0102",
            "AI::NNVMCAPI" : "1.01",
            "Function::Parameters" : "1.0705",
            "GraphViz" : "2.14",
            "Mouse" : "v2.1.0",
            "PDL" : "2.007"
         }
      },
      "test" : {
         "requires" : {}
      }
   },
   "release_status" : "stable",
   "version" : "1.0102"
}

META.yml  view on Meta::CPAN

---
abstract: 'Perl interface to MXNet machine learning library'
author:
  - 'Sergey Kolychev <sergeykolychev.github@gmail.com>'
build_requires: {}
configure_requires:
  ExtUtils::MakeMaker: '6.30'
dynamic_config: 0
generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.143240'
license: apache
meta-spec:
  url: http://module-build.sourceforge.net/META-spec-v1.4.html
  version: '1.4'
name: AI-MXNet
no_index:
  directory:
    - t
    - inc
requires:
  AI::MXNetCAPI: '1.0102'
  AI::NNVMCAPI: '1.01'
  Function::Parameters: '1.0705'
  GraphViz: '2.14'
  Mouse: v2.1.0
  PDL: '2.007'
version: '1.0102'

Makefile.PL  view on Meta::CPAN

use strict;
use warnings;

use 5.014000;

use ExtUtils::MakeMaker 6.30;



my %WriteMakefileArgs = (
  "ABSTRACT" => "Perl interface to MXNet machine learning library",
  "AUTHOR" => "Sergey Kolychev <sergeykolychev.github\@gmail.com>",
  "BUILD_REQUIRES" => {},
  "CONFIGURE_REQUIRES" => {
    "ExtUtils::MakeMaker" => "6.30"
  },
  "DISTNAME" => "AI-MXNet",
  "EXE_FILES" => [],
  "LICENSE" => "apache_2_0",
  "NAME" => "AI::MXNet",
  "PREREQ_PM" => {
    "AI::MXNetCAPI" => "1.0102",
    "AI::NNVMCAPI" => "1.01",
    "Function::Parameters" => "1.0705",
    "Mouse" => "v2.1.0",
    "PDL" => "2.007",
    "GraphViz" => "2.14"
  },
  "TEST_REQUIRES" => {},
  "VERSION" => "1.0101",
  "test" => {
    "TESTS" => "t/*.t"
  }
);


my %FallbackPrereqs = (
  "AI::MXNetCAPI" => "1.0102",
  "AI::NNVMCAPI" => "1.01",
  "Function::Parameters" => "1.0705",
  "Mouse" => "v2.1.0",
  "PDL" => "2.007",
  "GraphViz" => "2.14"
);


unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
  delete $WriteMakefileArgs{TEST_REQUIRES};
  delete $WriteMakefileArgs{BUILD_REQUIRES};
  $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
}

delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
  unless eval { ExtUtils::MakeMaker->VERSION(6.52) };

WriteMakefile(%WriteMakefileArgs);



README  view on Meta::CPAN

This archive contains the distribution AI-MXNet,
version 1.0102:

  Perl interface to MXNet machine learning library

Copyright (C) 2017 by Sergey Kolychev <sergeykolychev.github@gmail.com>

This library is licensed under Apache 2.0 license https://www.apache.org/licenses/LICENSE-2.0

examples/calculator.pl  view on Meta::CPAN

#!/usr/bin/perl
use strict;
use warnings;
use AI::MXNet ('mx');

## preparing the samples
## to train our network
sub samples {
    my($batch_size, $func) = @_;
    # get samples
    my $n = 16384;
    ## creates a pdl with $n rows and two columns with random
    ## floats in the range between 0 and 1
    my $data = PDL->random(2, $n);
    ## creates the pdl with $n rows and one column with labels
    ## labels are floats that either sum or product, etc of
    ## two random values in each corresponding row of the data pdl
    my $label = $func->($data->slice('0,:'), $data->slice('1,:'));
    # partition into train/eval sets
    my $edge = int($n / 8);
    my $validation_data = $data->slice(":,0:@{[ $edge - 1 ]}");
    my $validation_label = $label->slice(":,0:@{[ $edge - 1 ]}");
    my $train_data = $data->slice(":,$edge:");
    my $train_label = $label->slice(":,$edge:");
    # build iterators around the sets
    return(mx->io->NDArrayIter(
        batch_size => $batch_size,
        data => $train_data,
        label => $train_label,
    ), mx->io->NDArrayIter(
        batch_size => $batch_size,
        data => $validation_data,
        label => $validation_label,
    ));
}

## the network model
sub nn_fc {
    my $data = mx->sym->Variable('data');
    my $ln = mx->sym->exp(mx->sym->FullyConnected(
        data => mx->sym->log($data),
        num_hidden => 1,
    ));
    my $wide = mx->sym->Concat($data, $ln);
    my $fc = mx->sym->FullyConnected(
	$wide,
	num_hidden => 1
    );
    return mx->sym->MAERegressionOutput(data => $fc, name => 'softmax');
}

sub learn_function {
    my(%args) = @_;
    my $func = $args{func};
    my $batch_size = $args{batch_size}//128;
    my($train_iter, $eval_iter) = samples($batch_size, $func);
    my $sym = nn_fc();

    ## call as ./calculator.pl 1 to just print model and exit
    if($ARGV[0]) {
        my @dsz = @{$train_iter->data->[0][1]->shape};
        my @lsz = @{$train_iter->label->[0][1]->shape};
        my $shape = {
            data          => [ $batch_size, splice @dsz,  1 ],
            softmax_label => [ $batch_size, splice @lsz, 1 ],
        };
        print mx->viz->plot_network($sym, shape => $shape)->graph->as_png;
        exit;
    }

    my $model = mx->mod->Module(
        symbol => $sym,
        context => mx->cpu(),
    );
    $model->fit($train_iter,
        eval_data => $eval_iter,
        optimizer => 'adam',
        optimizer_params => {
            learning_rate => $args{lr}//0.01,
            rescale_grad => 1/$batch_size,
            lr_scheduler  => AI::MXNet::FactorScheduler->new(
        	step => 100,
        	factor => 0.99
            )
        },
        eval_metric => 'mse',
        num_epoch => $args{epoch}//25,
    );

    # refit the model for calling on 1 sample at a time
    my $iter = mx->io->NDArrayIter(
        batch_size => 1,
        data => PDL->pdl([[ 0, 0 ]]),
        label => PDL->pdl([[ 0 ]]),
    );
    $model->reshape(
        data_shapes => $iter->provide_data,
        label_shapes => $iter->provide_label,
    );

    # wrap a helper around making predictions
    my ($arg_params) = $model->get_params;
    for my $k (sort keys %$arg_params)
    {
	print "$k -> ". $arg_params->{$k}->aspdl."\n";
    }
    return sub {
        my($n, $m) = @_;
        return $model->predict(mx->io->NDArrayIter(
            batch_size => 1,
            data => PDL->new([[ $n, $m ]]),
        ))->aspdl->list;
    };
}

my $add = learn_function(func => sub {
    my($n, $m) = @_;
    return $n + $m;
});
my $sub = learn_function(func => sub {
    my($n, $m) = @_;
    return $n - $m;
}, batch_size => 50, epoch => 40);
my $mul = learn_function(func => sub {
    my($n, $m) = @_;
    return $n * $m;
}, batch_size => 50, epoch => 40);
my $div = learn_function(func => sub {
    my($n, $m) = @_;
    return $n / $m;
}, batch_size => 10, epoch => 80);


print "12345 + 54321 ≈ ", $add->(12345, 54321), "\n";
print "188 - 88 ≈ ", $sub->(188, 88), "\n";
print "250 * 2 ≈ ", $mul->(250, 2), "\n";
print "250 / 2 ≈ ", $div->(250, 2), "\n";

examples/char_lstm.pl  view on Meta::CPAN

#!/usr/bin/perl
use strict;
use warnings;
use PDL;
use Math::Random::Discrete;
use AI::MXNet qw(mx);
use AI::MXNet::Function::Parameters;
use Getopt::Long qw(HelpMessage);

GetOptions(
    'num-layers=i'   => \(my $num_layers   = 2       ),
    'num-hidden=i'   => \(my $num_hidden   = 256     ),
    'num-embed=i'    => \(my $num_embed    = 10      ),
    'num-seq=i'      => \(my $seq_size     = 60      ),
    'gpus=s'         => \(my $gpus                   ),
    'kv-store=s'     => \(my $kv_store     = 'device'),
    'num-epoch=i'    => \(my $num_epoch    = 25      ),
    'lr=f'           => \(my $lr           = 0.001    ),
    'optimizer=s'    => \(my $optimizer    = 'adam'   ),
    'mom=f'          => \(my $mom          = 0       ),
    'wd=f'           => \(my $wd           = 0.00001 ),
    'batch-size=i'   => \(my $batch_size   = 32      ),
    'disp-batches=i' => \(my $disp_batches = 50      ),
    'chkp-prefix=s'  => \(my $chkp_prefix  = 'lstm_' ),
    'cell-mode=s'    => \(my $cell_mode    = 'LSTM'  ),
    'sample-size=i'  => \(my $sample_size  = 10000   ),
    'chkp-epoch=i'   => \(my $chkp_epoch   = 1       ),
    'bidirectional=i'=> \(my $bidirectional= 0       ),
    'help'           => sub { HelpMessage(0) },
) or HelpMessage(1);

=head1 NAME

    char_lstm.pl - Example of training char LSTM RNN on tiny shakespeare using high level RNN interface
                   with optional inferred sampling (RNN generates Shakespeare like text)

=head1 SYNOPSIS

    --num-layers     number of stacked RNN layers, default=2
    --num-hidden     hidden layer size, default=256
    --num-embed      embed size, default=10
    --num-seq        sequence size, default=60
    --gpus           list of gpus to run, e.g. 0 or 0,2,5. empty means using cpu.
                     Increase batch size when using multiple gpus for best performance.
    --kv-store       key-value store type, default='device'
    --num-epochs     max num of epochs, default=25
    --lr             initial learning rate, default=0.01
    --optimizer      the optimizer type, default='adam'
    --mom            momentum for sgd, default=0.0
    --wd             weight decay for sgd, default=0.00001
    --batch-size     the batch size type, default=32
    --bidirectional  use bidirectional cell, default false (0)
    --disp-batches   show progress for every n batches, default=50
    --chkp-prefix    prefix for checkpoint files, default='lstm_'
    --cell-mode      RNN cell mode (LSTM, GRU, RNN, default=LSTM)
    --sample-size    a size of inferred sample text (default=10000) after each epoch
    --chkp-epoch     save checkpoint after this many epoch, default=1 (saving every checkpoint)

=cut

package AI::MXNet::RNN::IO::ASCIIIterator;
use Mouse;
extends AI::MXNet::DataIter;
has 'data'          => (is => 'ro',  isa => 'PDL',   required => 1);
has 'seq_size'      => (is => 'ro',  isa => 'Int',   required => 1);
has '+batch_size'   => (is => 'ro',  isa => 'Int',   required => 1);
has 'data_name'     => (is => 'ro',  isa => 'Str',   default => 'data');
has 'label_name'    => (is => 'ro',  isa => 'Str',   default => 'softmax_label');
has 'dtype'         => (is => 'ro',  isa => 'Dtype', default => 'float32');
has [qw/nd counter seq_counter vocab_size
    data_size provide_data provide_label idx/] => (is => 'rw', init_arg => undef);

sub BUILD
{
    my $self = shift;
    $self->data_size($self->data->nelem);
    my $segments = int(($self->data_size-$self->seq_size)/($self->batch_size*$self->seq_size));
    $self->idx([0..$segments-1]);
    $self->vocab_size($self->data->uniq->shape->at(0));
    $self->counter(0);
    $self->seq_counter(0);
    $self->nd(mx->nd->array($self->data, dtype => $self->dtype));
    my $shape = [$self->batch_size, $self->seq_size];
    $self->provide_data([
        AI::MXNet::DataDesc->new(
            name  => $self->data_name,
            shape => $shape,
            dtype => $self->dtype
        )
    ]);
    $self->provide_label([
        AI::MXNet::DataDesc->new(
            name  => $self->label_name,
            shape => $shape,
            dtype => $self->dtype
        )
    ]);
    $self->reset;
}

method reset()
{
    $self->counter(0);
    @{ $self->idx } = List::Util::shuffle(@{ $self->idx });
}

method next()
{
    return undef if $self->counter == @{$self->idx};
    my $offset = $self->idx->[$self->counter]*$self->batch_size*$self->seq_size + $self->seq_counter;
    my $data = $self->nd->slice(
        [$offset, $offset + $self->batch_size*$self->seq_size-1]
    )->reshape([$self->batch_size, $self->seq_size]);
    my $label = $self->nd->slice(
        [$offset + 1 , $offset + $self->batch_size*$self->seq_size]
    )->reshape([$self->batch_size, $self->seq_size]);
    $self->seq_counter($self->seq_counter + 1);
    if($self->seq_counter == $seq_size - 1)
    {
        $self->counter($self->counter + 1);
        $self->seq_counter(0);
    }
    return AI::MXNet::DataBatch->new(
        data          => [$data],
        label         => [$label],
        provide_data  => [
            AI::MXNet::DataDesc->new(
                name  => $self->data_name,
                shape => $data->shape,
                dtype => $self->dtype
            )
        ],
        provide_label => [
            AI::MXNet::DataDesc->new(
                name  => $self->label_name,
                shape => $label->shape,
                dtype => $self->dtype
            )
        ],
    );
}

package main;
my $file = "data/input.txt";
open(F, $file) or die "can't open $file: $!";
my $fdata;
{ local($/) = undef; $fdata = <F>; close(F) };
my %vocabulary; my $i = 0;
$fdata = pdl(map{ exists $vocabulary{$_} ? $vocabulary{$_} : ($vocabulary{$_} = $i++) } split(//, $fdata));
my $data_iter = AI::MXNet::RNN::IO::ASCIIIterator->new(
    batch_size => $batch_size,
    data       => $fdata,
    seq_size   => $seq_size
);
my %reverse_vocab = reverse %vocabulary;
my $mode = "${cell_mode}Cell";
my $stack = mx->rnn->SequentialRNNCell();
for my $i (0..$num_layers-1)
{
    my $cell = mx->rnn->$mode(num_hidden => $num_hidden, prefix => "lstm_${i}l0_");
    if($bidirectional)
    {
        $cell = mx->rnn->BidirectionalCell(
            $cell,
            mx->rnn->$mode(
                num_hidden => $num_hidden,
                prefix => "lstm_${i}r0_"
            ),
            output_prefix => "bi_lstm_$i"
        );
    }
    $stack->add($cell);
}

my $data  = mx->sym->Variable('data');
my $label = mx->sym->Variable('softmax_label');
my $embed = mx->sym->Embedding(
        data => $data, input_dim => scalar(keys %vocabulary),
        output_dim => $num_embed, name => 'embed'
);
$stack->reset;
my ($outputs, $states) = $stack->unroll($seq_size, inputs => $embed, merge_outputs => 1);
my $pred  = mx->sym->Reshape($outputs, shape => [-1, $num_hidden*(1+($bidirectional ? 1 : 0))]);
$pred     = mx->sym->FullyConnected(data => $pred, num_hidden => $data_iter->vocab_size, name => 'pred');
$label    = mx->sym->Reshape($label, shape => [-1]);
my $net   = mx->sym->SoftmaxOutput(data => $pred, label => $label, name => 'softmax');

my $contexts;
if(defined $gpus)
{
    $contexts = [map { mx->gpu($_) } split(/,/, $gpus)];
}
else
{
    $contexts = mx->cpu(0);
}

my $model = mx->mod->Module(
    symbol  => $net,
    context => $contexts
);
$model->fit(
    $data_iter,
    eval_metric         => mx->metric->Perplexity,
    kvstore             => $kv_store,
    optimizer           => $optimizer,
    optimizer_params    => {
                                learning_rate => $lr,
                                momentum      => $mom,
                                wd            => $wd,
                                clip_gradient => 5,
                                rescale_grad  => 1/$batch_size,
                                lr_scheduler  => AI::MXNet::FactorScheduler->new(step => 1000, factor => 0.99)
                        },
    initializer         => mx->init->Xavier(factor_type => "in", magnitude => 2.34),
    num_epoch           => $num_epoch,
    batch_end_callback  => mx->callback->Speedometer($batch_size, $disp_batches),
    ($chkp_epoch ? (epoch_end_callback  => [mx->rnn->do_rnn_checkpoint($stack, $chkp_prefix, $chkp_epoch), \&sample]) : ())
);

sub sample {
    return if not $sample_size;
    $model->reshape(data_shapes=>[['data',[1, $seq_size]]], label_shapes=>[['softmax_label',[1, $seq_size]]]);
    my $input = mx->nd->array($fdata->slice([0, $seq_size-1]))->reshape([1, $seq_size]);
    $| = 1;
    for (0..$sample_size-1)
    {
        $model->forward(mx->io->DataBatch(data=>[$input]), is_train => 0);
        my $prob = $model->get_outputs(0)->[0][0]->at($seq_size-1)->aspdl;
        my $next_char = Math::Random::Discrete->new($prob->reshape(-1)->unpdl, [0..scalar(keys %vocabulary)-1])->rand;
        print "$reverse_vocab{$next_char}";
        $input->at(0)->slice([0, $seq_size-2]) .= $input->at(0)->slice([1, $seq_size-1])->copy;
        $input->at(0)->at($seq_size-1) .= $next_char;
    }
    $model->reshape(data_shapes=>[['data',[$batch_size, $seq_size]]], label_shapes=>[['softmax_label',[$batch_size, $seq_size]]]);
}

examples/cudnn_lstm_bucketing.pl  view on Meta::CPAN

#!/usr/bin/perl
use strict;
use warnings;
use AI::MXNet qw(mx);
use AI::MXNet::Function::Parameters;
use AI::MXNet::Base;
use Getopt::Long qw(HelpMessage);

GetOptions(
    'test'            => \(my $do_test                ),
    'num-layers=i'    => \(my $num_layers   = 2       ),
    'num-hidden=i'    => \(my $num_hidden   = 256     ),
    'num-embed=i'     => \(my $num_embed    = 256     ),
    'num-seq=i'       => \(my $seq_size     = 32      ),
    'gpus=s'          => \(my $gpus                   ),
    'kv-store=s'      => \(my $kv_store     = 'device'),
    'num-epoch=i'     => \(my $num_epoch    = 25      ),
    'lr=f'            => \(my $lr           = 0.01    ),
    'optimizer=s'     => \(my $optimizer    = 'adam'  ),
    'mom=f'           => \(my $mom          = 0       ),
    'wd=f'            => \(my $wd           = 0.00001 ),
    'batch-size=i'    => \(my $batch_size   = 32      ),
    'disp-batches=i'  => \(my $disp_batches = 50      ),
    'model-prefix=s'  => \(my $model_prefix = 'lstm_' ),
    'load-epoch=i'    => \(my $load_epoch   = 0       ),
    'stack-rnn'       => \(my $stack_rnn              ),
    'bidirectional=i' => \(my $bidirectional          ),
    'dropout=f',      => \(my $dropout      = 0       ),
    'help'           => sub { HelpMessage(0) },
) or HelpMessage(1);

=head1 NAME

    char_lstm.pl - Example of training char LSTM RNN on tiny shakespeare using high level RNN interface

=head1 SYNOPSIS

    --test           Whether to test or train (default 0)
    --num-layers     number of stacked RNN layers, default=2
    --num-hidden     hidden layer size, default=200
    --num-seq        sequence size, default=32
    --gpus           list of gpus to run, e.g. 0 or 0,2,5. empty means using cpu.
                     Increase batch size when using multiple gpus for best performance.
    --kv-store       key-value store type, default='device'
    --num-epochs     max num of epochs, default=25
    --lr             initial learning rate, default=0.01
    --optimizer      the optimizer type, default='adam'
    --mom            momentum for sgd, default=0.0
    --wd             weight decay for sgd, default=0.00001
    --batch-size     the batch size type, default=32
    --disp-batches   show progress for every n batches, default=50
    --model-prefix   prefix for checkpoint files for loading/saving, default='lstm_'
    --load-epoch     load from epoch
    --stack-rnn      stack rnn to reduce communication overhead (1,0 default 0)
    --bidirectional  whether to use bidirectional layers (1,0 default 0)
    --dropout        dropout probability (1.0 - keep probability), default 0
=cut

$bidirectional = $bidirectional ? 1 : 0;
$stack_rnn     = $stack_rnn     ? 1 : 0;

func tokenize_text($fname, :$vocab=, :$invalid_label=-1, :$start_label=0)
{
    open(F, $fname) or die "Can't open $fname: $!";
    my @lines = map { my $l = [split(/ /)]; shift(@$l); $l } (<F>);
    my $sentences;
    ($sentences, $vocab) = mx->rnn->encode_sentences(
        \@lines,
        vocab         => $vocab,
        invalid_label => $invalid_label,
        start_label   => $start_label
    );
    return ($sentences, $vocab);
}

my $buckets = [10, 20, 30, 40, 50, 60];
my $start_label   = 1;
my $invalid_label = 0;

func get_data($layout)
{
    my ($train_sentences, $vocabulary) = tokenize_text(
        './data/ptb.train.txt', start_label => $start_label,
        invalid_label => $invalid_label
    );
    my ($validation_sentences) = tokenize_text(
        './data/ptb.test.txt', vocab => $vocabulary,
        start_label => $start_label, invalid_label => $invalid_label
    );
    my $data_train  = mx->rnn->BucketSentenceIter(
        $train_sentences, $batch_size, buckets => $buckets,
        invalid_label => $invalid_label,
        layout        => $layout
    );
    my $data_val    = mx->rnn->BucketSentenceIter(
        $validation_sentences, $batch_size, buckets => $buckets,
        invalid_label => $invalid_label,
        layout        => $layout
    );
    return ($data_train, $data_val, $vocabulary);
}

my $train = sub
{
    my ($data_train, $data_val, $vocab) = get_data('TN');
    my $cell;
    if($stack_rnn)
    {
        my $stack = mx->rnn->SequentialRNNCell();
        for my $i (0..$num_layers-1)
        {
            my $dropout_rate = 0;
            if($i < $num_layers-1)
            {
                $dropout_rate = $dropout;
            }
            $stack->add(
                mx->rnn->FusedRNNCell(
                    $num_hidden, num_layers => 1,
                    mode => 'lstm', prefix => "lstm_$i",
                    bidirectional => $bidirectional, dropout => $dropout_rate
                )
            );
        }
        $cell = $stack;
    }
    else
    {
        $cell = mx->rnn->FusedRNNCell(
            $num_hidden, mode => 'lstm', num_layers => $num_layers,
            bidirectional => $bidirectional, dropout => $dropout
        );
    }

    my $sym_gen = sub { my $seq_len = shift;
        my $data = mx->sym->Variable('data');
        my $label = mx->sym->Variable('softmax_label');
        my $embed = mx->sym->Embedding(data=>$data, input_dim=>scalar(keys %$vocab), output_dim=>$num_embed,name=>'embed');
        my ($output) = $cell->unroll($seq_len, inputs=>$embed, merge_outputs=>1, layout=>'TNC');
        my $pred = mx->sym->Reshape($output, shape=>[-1, $num_hidden*(1+$bidirectional)]);
        $pred = mx->sym->FullyConnected(data=>$pred, num_hidden=>scalar(keys %$vocab), name=>'pred');
        $label = mx->sym->Reshape($label, shape=>[-1]);
        $pred = mx->sym->SoftmaxOutput(data=>$pred, label=>$label, name=>'softmax');
        return ($pred, ['data'], ['softmax_label']);
    };

    my $contexts;
    if(defined $gpus)
    {
        $contexts = [map { mx->gpu($_) } split(/,/, $gpus)];
    }
    else
    {
        $contexts = mx->cpu(0);
    }

    my $model = mx->mod->BucketingModule(
        sym_gen             => $sym_gen,
        default_bucket_key  => $data_train->default_bucket_key,
        context             => $contexts
    );

    my ($arg_params, $aux_params);
    if($load_epoch)
    {
        (undef, $arg_params, $aux_params) = mx->rnn->load_rnn_checkpoint(
            $cell, $model_prefix, $load_epoch);
    }
    $model->fit(
        $data_train,
        eval_data           => $data_val,
        eval_metric         => mx->metric->Perplexity($invalid_label),
        kvstore             => $kv_store,
        optimizer           => $optimizer,
        optimizer_params    => {
                                learning_rate => $lr,
                                momentum      => $mom,
                                wd            => $wd,
                            },
        begin_epoch         => $load_epoch,
        initializer         => mx->init->Xavier(factor_type => "in", magnitude => 2.34),
        num_epoch           => $num_epoch,
        batch_end_callback  => mx->callback->Speedometer($batch_size, $disp_batches),
        ($model_prefix ? (epoch_end_callback  => mx->rnn->do_rnn_checkpoint($cell, $model_prefix, 1)) : ())
    );
};

my $test = sub {
    assert($model_prefix, "Must specifiy path to load from");
    my (undef, $data_val, $vocab) = get_data('NT');
    my $stack;
    if($stack_rnn)
    {
        $stack = mx->rnn->SequentialRNNCell();
        for my $i (0..$num_layers-1)
        {
            my $cell = mx->rnn->LSTMCell(num_hidden => $num_hidden, prefix => "lstm_${i}l0_");
            if($bidirectional)
            {
                $cell = mx->rnn->BidirectionalCell(
                    $cell,
                    mx->rnn->LSTMCell(
                        num_hidden => $num_hidden,
                        prefix => "lstm_${i}r0_"
                    ),
                    output_prefix => "bi_lstm_$i"
                );
            }
            $stack->add($cell);
        }
    }
    else
    {
        $stack = mx->rnn->FusedRNNCell(
            $num_hidden,  num_layers    => $num_layers,
            mode=>'lstm', bidirectional => $bidirectional
        )->unfuse()
    }
    my $sym_gen = sub {
        my $seq_len = shift;
        my $data  = mx->sym->Variable('data');
        my $label = mx->sym->Variable('softmax_label');
        my $embed = mx->sym->Embedding(
            data => $data, input_dim => scalar(keys %$vocab),
            output_dim => $num_embed, name => 'embed'
        );
        $stack->reset;
        my ($outputs, $states) = $stack->unroll($seq_len, inputs => $embed, merge_outputs => 1);
        my $pred = mx->sym->Reshape($outputs, shape => [-1, $num_hidden*(1+$bidirectional)]);
        $pred    = mx->sym->FullyConnected(data => $pred, num_hidden => scalar(keys %$vocab), name => 'pred');
        $label   = mx->sym->Reshape($label, shape => [-1]);
        $pred    = mx->sym->SoftmaxOutput(data => $pred, label => $label, name => 'softmax');
        return ($pred, ['data'], ['softmax_label']);
    };
    my $contexts;
    if($gpus)
    {
        $contexts = [map { mx->gpu($_) } split(/,/, $gpus)];
    }
    else
    {
        $contexts = mx->cpu(0);
    }

    my ($arg_params, $aux_params);
    if($load_epoch)
    {
        (undef, $arg_params, $aux_params) = mx->rnn->load_rnn_checkpoint(
            $stack, $model_prefix, $load_epoch);
    }
    my $model = mx->mod->BucketingModule(
        sym_gen             => $sym_gen,
        default_bucket_key  => $data_val->default_bucket_key,
        context             => $contexts
    );
    $model->bind(
        data_shapes  => $data_val->provide_data,
        label_shapes => $data_val->provide_label,
        for_training => 0,
        force_rebind => 0
    );
    $model->set_params($arg_params, $aux_params);
    my $score = $model->score($data_val,
        mx->metric->Perplexity($invalid_label),
        batch_end_callback=>mx->callback->Speedometer($batch_size, 5)
    );
};

if($num_layers >= 4 and split(/,/,$gpus) >= 4 and not $stack_rnn)
{
    print("WARNING: stack-rnn is recommended to train complex model on multiple GPUs\n");
}

if($do_test)
{
    # Demonstrates how to load a model trained with CuDNN RNN and predict
    # with non-fused MXNet symbol
    $test->();
}
else
{
    $train->();
}

examples/get_ptb_data.sh  view on Meta::CPAN

#!/usr/bin/env bash

RNN_DIR=$(cd `dirname $0`; pwd)
DATA_DIR="${RNN_DIR}/data/"

if [[ ! -d "${DATA_DIR}" ]]; then
  echo "${DATA_DIR} doesn't exist, will create one";
  mkdir -p ${DATA_DIR}
fi

wget -P ${DATA_DIR} https://raw.githubusercontent.com/dmlc/web-data/master/mxnet/ptb/ptb.train.txt;
wget -P ${DATA_DIR} https://raw.githubusercontent.com/dmlc/web-data/master/mxnet/ptb/ptb.valid.txt;
wget -P ${DATA_DIR} https://raw.githubusercontent.com/dmlc/web-data/master/mxnet/ptb/ptb.test.txt;
wget -P ${DATA_DIR} https://raw.githubusercontent.com/dmlc/web-data/master/mxnet/tinyshakespeare/input.txt;

examples/lstm_bucketing.pl  view on Meta::CPAN

#!/usr/bin/perl
use strict;
use warnings;
use PDL;
use AI::MXNet qw(mx);
use AI::MXNet::Function::Parameters;
use Getopt::Long qw(HelpMessage);

GetOptions(
    'num-layers=i'   => \(my $num_layers   = 2       ),
    'num-hidden=i'   => \(my $num_hidden   = 200     ),
    'num-embed=i'    => \(my $num_embed    = 200     ),
    'gpus=s'         => \(my $gpus                   ),
    'kv-store=s'     => \(my $kv_store     = 'device'),
    'num-epoch=i'    => \(my $num_epoch    = 25      ),
    'lr=f'           => \(my $lr           = 0.01    ),
    'optimizer=s'    => \(my $optimizer    = 'sgd'   ),
    'mom=f'          => \(my $mom          = 0       ),
    'wd=f'           => \(my $wd           = 0.00001 ),
    'batch-size=i'   => \(my $batch_size   = 32      ),
    'disp-batches=i' => \(my $disp_batches = 50      ),
    'chkp-prefix=s'  => \(my $chkp_prefix  = 'lstm_' ),
    'chkp-epoch=i'   => \(my $chkp_epoch   = 0       ),
    'help'           => sub { HelpMessage(0) },
) or HelpMessage(1);

=head1 NAME

    lstm_bucketing.pl - Example of training LSTM RNN on Penn Tree Bank data using high level RNN interface

=head1 SYNOPSIS

    --num-layers     number of stacked RNN layers, default=2
    --num-hidden     hidden layer size, default=200
    --num-embed      embedding layer size, default=200
    --gpus           list of gpus to run, e.g. 0 or 0,2,5. empty means using cpu.
                     Increase batch size when using multiple gpus for best performance.
    --kv-store       key-value store type, default='device'
    --num-epochs     max num of epochs, default=25
    --lr             initial learning rate, default=0.01
    --optimizer      the optimizer type, default='sgd'
    --mom            momentum for sgd, default=0.0
    --wd             weight decay for sgd, default=0.00001
    --batch-size     the batch size type, default=32
    --disp-batches   show progress for every n batches, default=50
    --chkp-prefix    prefix for checkpoint files, default='lstm_'
    --chkp-epoch     save checkpoint after this many epoch, default=0 (saving checkpoints is disabled)

=cut
func tokenize_text($fname, :$vocab=, :$invalid_label=-1, :$start_label=0)
{
    open(F, $fname) or die "Can't open $fname: $!";
    my @lines = map { my $l = [split(/ /)]; shift(@$l); $l } (<F>);
    my $sentences;
    ($sentences, $vocab) = mx->rnn->encode_sentences(
        \@lines,
        vocab         => $vocab,
        invalid_label => $invalid_label,
        start_label   => $start_label
    );
    return ($sentences, $vocab);
}

my $buckets = [10, 20, 30, 40, 50, 60];
my $start_label   = 1;
my $invalid_label = 0;

my ($train_sentences, $vocabulary) = tokenize_text(
    './data/ptb.train.txt', start_label => $start_label,
    invalid_label => $invalid_label
);
my ($validation_sentences) = tokenize_text(
    './data/ptb.test.txt', vocab => $vocabulary,
    start_label => $start_label, invalid_label => $invalid_label
);
my $data_train  = mx->rnn->BucketSentenceIter(
    $train_sentences, $batch_size, buckets => $buckets,
    invalid_label => $invalid_label
);
my $data_val    = mx->rnn->BucketSentenceIter(
    $validation_sentences, $batch_size, buckets => $buckets,
    invalid_label => $invalid_label
);

my $stack = mx->rnn->SequentialRNNCell();
for my $i (0..$num_layers-1)
{
    $stack->add(mx->rnn->LSTMCell(num_hidden => $num_hidden, prefix => "lstm_l${i}_"));
}

my $sym_gen = sub {
    my $seq_len = shift;
    my $data  = mx->sym->Variable('data');
    my $label = mx->sym->Variable('softmax_label');
    my $embed = mx->sym->Embedding(
        data => $data, input_dim => scalar(keys %$vocabulary),
        output_dim => $num_embed, name => 'embed'
    );
    $stack->reset;
    my ($outputs, $states) = $stack->unroll($seq_len, inputs => $embed, merge_outputs => 1);
    my $pred = mx->sym->Reshape($outputs, shape => [-1, $num_hidden]);
    $pred    = mx->sym->FullyConnected(data => $pred, num_hidden => scalar(keys %$vocabulary), name => 'pred');
    $label   = mx->sym->Reshape($label, shape => [-1]);
    $pred    = mx->sym->SoftmaxOutput(data => $pred, label => $label, name => 'softmax');
    return ($pred, ['data'], ['softmax_label']);
};

my $contexts;
if(defined $gpus)
{
    $contexts = [map { mx->gpu($_) } split(/,/, $gpus)];
}
else
{
    $contexts = mx->cpu(0);
}

my $model = mx->mod->BucketingModule(
    sym_gen             => $sym_gen,
    default_bucket_key  => $data_train->default_bucket_key,
    context             => $contexts
);

$model->fit(
    $data_train,
    eval_data           => $data_val,
    eval_metric         => mx->metric->Perplexity($invalid_label),
    kvstore             => $kv_store,
    optimizer           => $optimizer,
    optimizer_params    => {
                                learning_rate => $lr,
                                momentum      => $mom,
                                wd            => $wd,
                        },
    initializer         => mx->init->Xavier(factor_type => "in", magnitude => 2.34),
    num_epoch           => $num_epoch,
    batch_end_callback  => mx->callback->Speedometer($batch_size, $disp_batches),
    ($chkp_epoch ? (epoch_end_callback  => mx->rnn->do_rnn_checkpoint($stack, $chkp_prefix, $chkp_epoch)) : ())
);

examples/mnist.pl  view on Meta::CPAN

#!/usr/bin/perl
use strict;
use warnings;
# derived from http://mxnet.io/tutorials/python/mnist.html
use LWP::UserAgent ();
use PDL ();
#use Gtk2 '-init';
use AI::MXNet ('mx');

my $ua = LWP::UserAgent->new();

sub download_data {
    my($url, $force_download) = @_;
    $force_download = 1 if @_ < 2;
    my $fname = (split m{/}, $url)[-1];
    if($force_download or not -f $fname) {
        $ua->get($url, ':content_file' => $fname);
    }
    return $fname;
}

sub read_data {
    my($label_url, $image_url) = @_;
    my($magic, $num, $rows, $cols);

    open my($flbl), '<:gzip', download_data($label_url);
    read $flbl, my($buf), 8;
    ($magic, $num) = unpack 'N2', $buf;
    my $label = PDL->new();
    $label->set_datatype($PDL::Types::PDL_B);
    $label->setdims([ $num ]);
    read $flbl, ${$label->get_dataref}, $num;
    $label->upd_data();

    open my($fimg), '<:gzip', download_data($image_url);
    read $fimg, $buf, 16;
    ($magic, $num, $rows, $cols) = unpack 'N4', $buf;
    my $image = PDL->new();
    $image->set_datatype($PDL::Types::PDL_B);
    $image->setdims([ $rows, $cols, $num ]);
    read $fimg, ${$image->get_dataref}, $num * $rows * $cols;
    $image->upd_data();

    return($label, $image);
}

my $path='http://yann.lecun.com/exdb/mnist/';
my($train_lbl, $train_img) = read_data(
    "${path}train-labels-idx1-ubyte.gz", "${path}train-images-idx3-ubyte.gz");
my($val_lbl, $val_img) = read_data(
    "${path}t10k-labels-idx1-ubyte.gz", "${path}t10k-images-idx3-ubyte.gz");

sub show_sample {
    print 'label: ', $train_lbl->slice('0:9'), "\n";
    my $hbox = Gtk2::HBox->new(0, 2);
    for my $i (0 .. 9) {
        my $img = $train_img->slice(":,:,$i");
        my($w, $h) = $img->dims;
        $img->make_physical();
        # ugh, pixbufs don't have a grayscale colorspace?!
        # burst it to rgb I guess.
        my $data = pack 'c*', map { $_, $_, $_ } unpack 'c*', ${$img->get_dataref};
        $hbox->add(Gtk2::Image->new_from_pixbuf(
            Gtk2::Gdk::Pixbuf->new_from_data($data, 'rgb', 0, 8, $w, $h, $w * 3)
        ));
    }
    my $win = Gtk2::Window->new('toplevel');
    $win->signal_connect(delete_event => sub { Gtk2->main_quit() });
    $win->add($hbox);
    $win->show_all();
    Gtk2->main();
}

sub show_network {
    my($viz) = @_;
    my $load = Gtk2::Gdk::PixbufLoader->new();
    $load->write($viz->graph->as_png);
    $load->close();
    my $img = Gtk2::Image->new_from_pixbuf($load->get_pixbuf());
    my $sw = Gtk2::ScrolledWindow->new(undef, undef);
    $sw->add_with_viewport($img);
    my $win = Gtk2::Window->new('toplevel');
    $win->signal_connect(delete_event => sub { Gtk2->main_quit() });
    $win->add($sw);
    $win->show_all();
    Gtk2->main();
}

#show_sample();

sub to4d {
    my($img) = @_;
    return $img->reshape(28, 28, 1, ($img->dims)[2])->float / 255;
}

my $batch_size = 100;
my $train_iter = mx->io->NDArrayIter(
    data => to4d($train_img),
    label => $train_lbl,
    batch_size => $batch_size,
    shuffle => 1,
);
my $val_iter = mx->io->NDArrayIter(
    data => to4d($val_img),
    label => $val_lbl,
    batch_size => $batch_size,
);

# Create a place holder variable for the input data
my $data = mx->sym->Variable('data');

sub nn_fc {
    # Epoch[9] Train-accuracy=0.978889
    # Epoch[9] Time cost=145.437
    # Epoch[9] Validation-accuracy=0.964600
    my($data) = @_;

    # Flatten the data from 4-D shape (batch_size, num_channel, width, height) 
    # into 2-D (batch_size, num_channel*width*height)
    $data = mx->sym->Flatten(data => $data);

    # The first fully-connected layer
#    my $fc1  = mx->sym->FullyConnected(data => $data, name => 'fc1', num_hidden => 128);
#    # Apply relu to the output of the first fully-connnected layer
#    my $act1 = mx->sym->Activation(data => $fc1, name => 'relu1', act_type => "relu");

    # The second fully-connected layer and the according activation function
    my $fc2  = mx->sym->FullyConnected(data => $data, name => 'fc2', num_hidden => 64);
    my $act2 = mx->sym->Activation(data => $fc2, name => 'relu2', act_type => "relu");

    # The thrid fully-connected layer, note that the hidden size should be 10, which is the number of unique digits
    my $fc3  = mx->sym->FullyConnected(data => $act2, name => 'fc3', num_hidden => 10);
    # The softmax and loss layer
    my $mlp  = mx->sym->SoftmaxOutput(data => $fc3, name => 'softmax');
    return $mlp;
}

sub nn_conv {
    my($data) = @_;
    # Epoch[9] Batch [200]	Speed: 1625.07 samples/sec	Train-accuracy=0.992090
    # Epoch[9] Batch [400]	Speed: 1630.12 samples/sec	Train-accuracy=0.992850
    # Epoch[9] Train-accuracy=0.991357
    # Epoch[9] Time cost=36.817
    # Epoch[9] Validation-accuracy=0.988100

    my $conv1= mx->symbol->Convolution(data => $data, name => 'conv1', num_filter => 20, kernel => [5,5], stride => [2,2]);
    my $bn1  = mx->symbol->BatchNorm(data => $conv1, name => "bn1");
    my $act1 = mx->symbol->Activation(data => $bn1, name => 'relu1', act_type => "relu");
    my $mp1  = mx->symbol->Pooling(data => $act1, name => 'mp1', kernel => [2,2], stride =>[1,1], pool_type=>'max');

    my $conv2= mx->symbol->Convolution(data => $mp1, name => 'conv2', num_filter => 50, kernel=>[3,3], stride=>[2,2]);
    my $bn2  = mx->symbol->BatchNorm(data => $conv2, name=>"bn2");
    my $act2 = mx->symbol->Activation(data => $bn2, name=>'relu2', act_type=>"relu");
    my $mp2  = mx->symbol->Pooling(data => $act2, name => 'mp2', kernel=>[2,2], stride=>[1,1], pool_type=>'max');


    my $fl   = mx->symbol->Flatten(data => $mp2, name=>"flatten");
    my $fc1  = mx->symbol->FullyConnected(data => $fl,  name=>"fc1", num_hidden=>100);
    my $act3 = mx->symbol->Activation(data => $fc1, name=>'relu3', act_type=>"relu");
    my $fc2  = mx->symbol->FullyConnected(data => $act3, name=>'fc2', num_hidden=>30);
    my $act4 = mx->symbol->Activation(data => $fc2, name=>'relu4', act_type=>"relu");
    my $fc3  = mx->symbol->FullyConnected(data => $act4, name=>'fc3', num_hidden=>10);
    my $softmax = mx->symbol->SoftmaxOutput(data => $fc3, name => 'softmax');
    return $softmax;
}

my $mlp = $ARGV[0] ? nn_conv($data) : nn_fc($data);

#We visualize the network structure with output size (the batch_size is ignored.)
#my $shape = { data => [ $batch_size, 1, 28, 28 ] };
#show_network(mx->viz->plot_network($mlp, shape => $shape));

my $model = mx->mod->Module(
    symbol => $mlp,       # network structure
);
$model->fit(
    $train_iter,       # training data
    num_epoch => 10,      # number of data passes for training 
    eval_data => $val_iter, # validation data
    batch_end_callback => mx->callback->Speedometer($batch_size, 200), # output progress for each 200 data batches
    optimizer => 'adam',
);


examples/plot_network.pl  view on Meta::CPAN

#!/usr/bin/perl
use strict;
use warnings;
use AI::MXNet qw(mx);

### model
my $data = mx->symbol->Variable('data');
my $conv1= mx->symbol->Convolution(data => $data, name => 'conv1', num_filter => 32, kernel => [3,3], stride => [2,2]);
my $bn1  = mx->symbol->BatchNorm(data => $conv1, name => "bn1");
my $act1 = mx->symbol->Activation(data => $bn1, name => 'relu1', act_type => "relu");
my $mp1  = mx->symbol->Pooling(data => $act1, name => 'mp1', kernel => [2,2], stride =>[2,2], pool_type=>'max');

my $conv2= mx->symbol->Convolution(data => $mp1, name => 'conv2', num_filter => 32, kernel=>[3,3], stride=>[2,2]);
my $bn2  = mx->symbol->BatchNorm(data => $conv2, name=>"bn2");
my $act2 = mx->symbol->Activation(data => $bn2, name=>'relu2', act_type=>"relu");
my $mp2  = mx->symbol->Pooling(data => $act2, name => 'mp2', kernel=>[2,2], stride=>[2,2], pool_type=>'max');


my $fl   = mx->symbol->Flatten(data => $mp2, name=>"flatten");
my $fc1  = mx->symbol->FullyConnected(data => $fl,  name=>"fc1", num_hidden=>30);
my $act3 = mx->symbol->Activation(data => $fc1, name=>'relu3', act_type=>"relu");
my $fc2  = mx->symbol->FullyConnected(data => $act3, name=>'fc2', num_hidden=>10);
my $softmax = mx->symbol->SoftmaxOutput(data => $fc2, name => 'softmax');

## creates the image file in working directory, you need GraphViz installed for this to work
mx->viz->plot_network($softmax, save_format => 'png')->render("network.png");

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

package AI::MXNet;
use v5.14.0;
use strict;
use warnings;
use AI::MXNet::Base;
use AI::MXNet::Callback;
use AI::MXNet::NDArray;
use AI::MXNet::Symbol;
use AI::MXNet::Executor;
use AI::MXNet::Executor::Group;
use AI::MXNet::Rtc;
use AI::MXNet::Random;
use AI::MXNet::Initializer;
use AI::MXNet::Optimizer;
use AI::MXNet::KVStore;
use AI::MXNet::KVStoreServer;
use AI::MXNet::IO;
use AI::MXNet::Metric;
use AI::MXNet::LRScheduler;
use AI::MXNet::Monitor;
use AI::MXNet::Profiler;
use AI::MXNet::Module::Base;
use AI::MXNet::Module;
use AI::MXNet::Module::Bucketing;
use AI::MXNet::RNN;
use AI::MXNet::Visualization;
use AI::MXNet::RecordIO;
use AI::MXNet::Image;
use AI::MXNet::Contrib;
use AI::MXNet::Contrib::AutoGrad;
use AI::MXNet::CachedOp;
our $VERSION = '1.0102';

sub import
{
    my ($class, $short_name) = @_;
    if($short_name)
    {
        $short_name =~ s/[^\w:]//g;
        if(length $short_name)
        {
            my $short_name_package =<<"EOP";
            package $short_name;
            no warnings 'redefine';
            sub nd { 'AI::MXNet::NDArray' }
            sub sym { 'AI::MXNet::Symbol' }
            sub symbol { 'AI::MXNet::Symbol' }
            sub init { 'AI::MXNet::Initializer' }
            sub initializer { 'AI::MXNet::Initializer' }
            sub optimizer { 'AI::MXNet::Optimizer' }
            sub opt { 'AI::MXNet::Optimizer' }
            sub rnd { 'AI::MXNet::Random' }
            sub random { 'AI::MXNet::Random' }
            sub Context { shift; AI::MXNet::Context->new(\@_) }
            sub cpu { AI::MXNet::Context->cpu(\$_[1]//0) }
            sub gpu { AI::MXNet::Context->gpu(\$_[1]//0) }
            sub kv { 'AI::MXNet::KVStore' }
            sub recordio { 'AI::MXNet::RecordIO' }
            sub io { 'AI::MXNet::IO' }
            sub metric { 'AI::MXNet::Metric' }
            sub mod { 'AI::MXNet::Module' }
            sub mon { 'AI::MXNet::Monitor' }
            sub viz { 'AI::MXNet::Visualization' }
            sub rnn { 'AI::MXNet::RNN' }
            sub callback { 'AI::MXNet::Callback' }
            sub img { 'AI::MXNet::Image' }
            sub contrib { 'AI::MXNet::Contrib' }
            sub name { '$short_name' }
            sub AttrScope { shift; AI::MXNet::Symbol::AttrScope->new(\@_) }
            *AI::MXNet::Symbol::AttrScope::current = sub { \$${short_name}::AttrScope; };
            \$${short_name}::AttrScope = AI::MXNet::Symbol::AttrScope->new;
            sub Prefix { AI::MXNet::Symbol::Prefix->new(prefix => \$_[1]) }
            *AI::MXNet::Symbol::NameManager::current = sub { \$${short_name}::NameManager; };
            \$${short_name}::NameManager = AI::MXNet::Symbol::NameManager->new;
            *AI::MXNet::Context::current_ctx = sub { \$${short_name}::Context; };
            \$${short_name}::Context = AI::MXNet::Context->new(device_type => 'cpu', device_id => 0);
            1;
EOP
            eval $short_name_package;
        }
    }
}

1;
__END__

=encoding UTF-8

=head1 NAME

AI::MXNet - Perl interface to MXNet machine learning library

=head1 SYNOPSIS

    ## Convolutional NN for recognizing hand-written digits in MNIST dataset
    ## It's considered "Hello, World" for Neural Networks
    ## For more info about the MNIST problem please refer to http://neuralnetworksanddeeplearning.com/chap1.html

    use strict;
    use warnings;
    use AI::MXNet qw(mx);
    use AI::MXNet::TestUtils qw(GetMNIST_ubyte);
    use Test::More tests => 1;

    # symbol net
    my $batch_size = 100;

    ### model
    my $data = mx->symbol->Variable('data');
    my $conv1= mx->symbol->Convolution(data => $data, name => 'conv1', num_filter => 32, kernel => [3,3], stride => [2,2]);
    my $bn1  = mx->symbol->BatchNorm(data => $conv1, name => "bn1");
    my $act1 = mx->symbol->Activation(data => $bn1, name => 'relu1', act_type => "relu");
    my $mp1  = mx->symbol->Pooling(data => $act1, name => 'mp1', kernel => [2,2], stride =>[2,2], pool_type=>'max');

    my $conv2= mx->symbol->Convolution(data => $mp1, name => 'conv2', num_filter => 32, kernel=>[3,3], stride=>[2,2]);
    my $bn2  = mx->symbol->BatchNorm(data => $conv2, name=>"bn2");
    my $act2 = mx->symbol->Activation(data => $bn2, name=>'relu2', act_type=>"relu");
    my $mp2  = mx->symbol->Pooling(data => $act2, name => 'mp2', kernel=>[2,2], stride=>[2,2], pool_type=>'max');


    my $fl   = mx->symbol->Flatten(data => $mp2, name=>"flatten");
    my $fc1  = mx->symbol->FullyConnected(data => $fl,  name=>"fc1", num_hidden=>30);
    my $act3 = mx->symbol->Activation(data => $fc1, name=>'relu3', act_type=>"relu");
    my $fc2  = mx->symbol->FullyConnected(data => $act3, name=>'fc2', num_hidden=>10);
    my $softmax = mx->symbol->SoftmaxOutput(data => $fc2, name => 'softmax');

    # check data
    GetMNIST_ubyte();

    my $train_dataiter = mx->io->MNISTIter({
        image=>"data/train-images-idx3-ubyte",
        label=>"data/train-labels-idx1-ubyte",
        data_shape=>[1, 28, 28],
        batch_size=>$batch_size, shuffle=>1, flat=>0, silent=>0, seed=>10});
    my $val_dataiter = mx->io->MNISTIter({
        image=>"data/t10k-images-idx3-ubyte",
        label=>"data/t10k-labels-idx1-ubyte",
        data_shape=>[1, 28, 28],
        batch_size=>$batch_size, shuffle=>1, flat=>0, silent=>0});

    my $n_epoch = 1;
    my $mod = mx->mod->new(symbol => $softmax);
    $mod->fit(
        $train_dataiter,
        eval_data => $val_dataiter,
        optimizer_params=>{learning_rate=>0.01, momentum=> 0.9},
        num_epoch=>$n_epoch
    );
    my $res = $mod->score($val_dataiter, mx->metric->create('acc'));
    ok($res->{accuracy} > 0.8);

=head1 DESCRIPTION

    Perl interface to MXNet machine learning library.

=head1 BUGS AND INCOMPATIBILITIES

    Parity with Python inteface is mostly achieved, few deprecated
    and not often used features left unported for now.

=head1 SEE ALSO

    http://mxnet.io/
    https://github.com/dmlc/mxnet/tree/master/perl-package
    Function::Parameters, Mouse

=head1 AUTHOR

    Sergey Kolychev, <sergeykolychev.github@gmail.com>

=head1 COPYRIGHT & LICENSE

    Copyright (C) 2017 by Sergey Kolychev <sergeykolychev.github@gmail.com>

    This library is licensed under Apache 2.0 license https://www.apache.org/licenses/LICENSE-2.0

=cut

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

package AI::MXNet::Base;
use strict;
use warnings;
use PDL;
use PDL::Types qw();
use AI::MXNetCAPI 1.0102;
use AI::NNVMCAPI 1.01;
use AI::MXNet::Types;
use Time::HiRes;
use Carp;
use Exporter;
use base qw(Exporter);
use List::Util qw(shuffle);

@AI::MXNet::Base::EXPORT = qw(product enumerate assert zip check_call build_param_doc 
                              pdl cat dog svd bisect_left pdl_shuffle
                              DTYPE_STR_TO_MX DTYPE_MX_TO_STR DTYPE_MX_TO_PDL
                              DTYPE_PDL_TO_MX DTYPE_MX_TO_PERL GRAD_REQ_MAP);
@AI::MXNet::Base::EXPORT_OK = qw(pzeros pceil);
use constant DTYPE_STR_TO_MX => {
    float32 => 0,
    float64 => 1,
    float16 => 2,
    uint8   => 3,
    int32   => 4
};
use constant DTYPE_MX_TO_STR => {
    0 => 'float32',
    1 => 'float64',
    2 => 'float16',
    3 => 'uint8',
    4 => 'int32'
};
use constant DTYPE_MX_TO_PDL => {
    0 => 6,
    1 => 7,
    2 => 6,
    3 => 0,
    4 => 3,
    float32 => 6,
    float64 => 7,
    float16 => 6,
    uint8   => 0,
    int32   => 3
};
use constant DTYPE_PDL_TO_MX => {
    6 => 0,
    7 => 1,
    0 => 3,
    3 => 4,
};
use constant DTYPE_MX_TO_PERL => {
    0 => 'f',
    1 => 'd',
    2 => 'S',
    3 => 'C',
    4 => 'l',
    float32 => 'f',
    float64 => 'd',
    float16 => 'S',
    uint8   => 'C',
    int32   => 'l'
};
use constant GRAD_REQ_MAP => {
    null  => 0,
    write => 1,
    add   => 3
};

=head1 NAME

    AI::MXNet::Base - Helper functions

=head1 DEFINITION

    Helper functions

=head2 zip

    Perl version of for x,y,z in zip (arr_x, arr_y, arr_z)

    Parameters
    ----------
    $sub_ref, called with @_ filled with $arr_x->[$i], $arr_y->[$i], $arr_z->[$i]
    for each loop iteration.

    @array_refs
=cut

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

=head2 enumerate

    Same as zip, but the argument list in the anonymous sub is prepended
    by the iteration count.
=cut

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

=head2 product

    Calculates the product of the input agruments.
=cut

sub product
{
    my $p = 1;
    map { $p = $p * $_ } @_;
    return $p;
}

=head2 bisect_left

    https://hg.python.org/cpython/file/2.7/Lib/bisect.py
=cut

sub bisect_left
{
    my ($a, $x, $lo, $hi) = @_;
    $lo //= 0;
    $hi //= @{ $a };
    if($lo < 0)
    {
        Carp::confess('lo must be non-negative');
    }
    while($lo < $hi)
    {
        my $mid = int(($lo+$hi)/2);
        if($a->[$mid] < $x)
        {
            $lo = $mid+1;
        }
        else
        {
            $hi = $mid;
        }
    }
    return $lo;
}

=head2 pdl_shuffle

    Shuffle the pdl by the last dimension

    Parameters
    -----------
    PDL $pdl
    $preshuffle Maybe[ArrayRef[Index]], if defined the array elements are used
    as shuffled last dimension's indexes
=cut


sub pdl_shuffle
{
    my ($pdl, $preshuffle) = @_;
    my $c = $pdl->copy;
    my @shuffle = $preshuffle ? @{ $preshuffle } : shuffle(0..$pdl->dim(-1)-1);
    my $rem = $pdl->ndims-1;
    for my $i (0..$pdl->dim(-1)-1)
    {
        $c->slice(('X')x$rem, $i) .= $pdl->slice(('X')x$rem, $shuffle[$i])
    }
    $c;
}

=head2 assert

    Parameters
    -----------
    Bool $input
    Str  $error_str
    Calls Carp::confess with $error_str//"AssertionError" if the $input is false
=cut

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

=head2 check_call

    Checks the return value of C API call

    This function will raise an exception when error occurs.
    Every API call is wrapped with this function.

    Returns the C API call return values stripped of first return value,
    checks for return context and returns first element in
    the values list when called in scalar context.
=cut

sub check_call
{
    Carp::confess(AI::MXNetCAPI::GetLastError()) if shift;
    return wantarray ? @_ : $_[0];
}

=head2 build_param_doc

    Builds argument docs in python style.

    arg_names : array ref of str
        Argument names.

    arg_types : array ref of str
        Argument type information.

    arg_descs : array ref of str
        Argument description information.

    remove_dup : boolean, optional
        Whether to remove duplication or not.

    Returns
    -------
    docstr : str
        Python docstring of parameter sections.
=cut

sub build_param_doc
{
    my ($arg_names, $arg_types, $arg_descs, $remove_dup) = @_;
    $remove_dup //= 1;
    my %param_keys;
    my @param_str;
    zip(sub { 
            my ($key, $type_info, $desc) = @_;
            return if exists $param_keys{$key} and $remove_dup;
            $param_keys{$key} = 1;
            my $ret = sprintf("%s : %s", $key, $type_info);
            $ret .= "\n    ".$desc if length($desc); 
            push @param_str,  $ret;
        },
        $arg_names, $arg_types, $arg_descs
    );
    return sprintf("Parameters\n----------\n%s\n", join("\n", @param_str));
}

=head2 _notify_shutdown

    Notify MXNet about shutdown.
=cut

sub _notify_shutdown
{
    check_call(AI::MXNetCAPI::NotifyShutdown());
}

END {
    _notify_shutdown();
    Time::HiRes::sleep(0.01);
}

*pzeros = \&zeros;
*pceil  = \&ceil;
## making sure that we can stringify arbitrarily large piddles
$PDL::toolongtoprint = 1000_000_000;

1;

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

package AI::MXNet::CachedOp;

=head1 NAME

    AI::MXNet::CachedOp - A wrapper around CachedOpHandle
=cut

use strict;
use warnings;
use AI::MXNet::Base;
use Mouse;
use overload '&{}' => sub { my $self = shift; sub { $self->call(@_) } };

has 'handle'   => (is => 'ro', isa => 'CachedOpHandle', required => 1);
around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my ($sym) = @_;
    my $handle = check_call(
        AI::MXNetCAPI::CreateCachedOp(
            $sym->handle
        )
    );
    return $class->$orig(handle => $handle);
};

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

sub call
{
    my $self = shift;
    my @args;
    my %kwargs;
    if(blessed $_[0] and $_[0]->isa('AI::MXNet::NDArray'))
    {
        while(blessed $_[0] and $_[0]->isa('AI::MXNet::NDArray'))
        {
            push @args, shift(@_);
        }
        %kwargs = @_;
    }
    else
    {
        %kwargs = @_;
    }
    my $out = delete $kwargs{out};
    if(%kwargs)
    {
        confess(
            "AI::MXNet::CachedOp::call got unexpected keyword argument(s): ".
            join(', ', keys %kwargs)
        );
    }
    my $original_output;
    if(defined $out)
    {
        $original_output = $out;
        if(blessed($out))
        {
            $out = [$out];
        }
    }
    else
    {
        $out = [];
    }
    my $output = check_call(
        AI::MXNetCAPI::InvokeCachedOp(
            $self->handle,
            scalar(@args),
            [map { $_->handle } @args],
            [map { $_->handle } @$out]
        )
    );
    return $original_output if defined $original_output;
    if(@$output == 1)
    {
        return AI::MXNet::NDArray->new(handle => $output->[0]);
    }
    else
    {
        return [map { AI::MXNet::NDArray->new(handle => $_) } @$output];
    }
}

1;

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

package AI::MXNet::Callback;
use strict;
use warnings;
use List::Util qw/max/;
use AI::MXNet::Function::Parameters;
use Mouse;
use overload "&{}" => sub { my $self = shift; sub { $self->call(@_) } };

=head1 NAME

    AI::MXNet::Callback - A collection of predefined callback functions
=cut

=head2 module_checkpoint

    Callback to save the module setup in the checkpoint files.

    Parameters
    ----------
    $mod : subclass of AI::MXNet::Module::Base
        The module to checkpoint.
    $prefix : str
        The file prefix to checkpoint to
    $period=1 : int
        How many epochs to wait before checkpointing. Default is 1.
    $save_optimizer_states=0 : Bool
        Whether to save optimizer states for later training.

    Returns
    -------
    $callback : sub ref
        The callback function that can be passed as iter_end_callback to fit.
=cut

method module_checkpoint(
    AI::MXNet::Module::Base $mod,
    Str $prefix,
    Int $period=1,
    Int $save_optimizer_states=0
)
{
    $period = max(1, $period);
    return sub {
        my ($iter_no, $sym, $arg, $aux) = @_;
        if(($iter_no + 1) % $period == 0)
        {
            $mod->save_checkpoint($prefix, $iter_no + 1, $save_optimizer_states);
        }
    }
}

=head2 log_train_metric

    Callback to log the training evaluation result every period.

    Parameters
    ----------
    $period : Int
        The number of batches after which to log the training evaluation metric.
    $auto_reset : Bool
        Whether to reset the metric after the logging.

    Returns
    -------
    $callback : sub ref
        The callback function that can be passed as iter_epoch_callback to fit.
=cut

method log_train_metric(Int $period, Int $auto_reset=0)
{
    return sub {
        my ($param) = @_;
        if($param->nbatch % $period == 0 and defined $param->eval_metric)
        {
            my $name_value = $param->eval_metric->get_name_value;
            while(my ($name, $value) = each %{ $name_value })
            {
                AI::MXNet::Logging->info(
                    "Iter[%d] Batch[%d] Train-%s=%f",
                    $param->epoch, $param->nbatch, $name, $value
                );
            }
            $param->eval_metric->reset if $auto_reset;
        }
    }
}

package AI::MXNet::Speedometer;
use Mouse;
use Time::HiRes qw/time/;
extends 'AI::MXNet::Callback';

=head1 NAME

    AI::MXNet::Speedometer - A callback that logs training speed 
=cut

=head1 DESCRIPTION

    Calculate and log training speed periodically.

    Parameters
    ----------
    batch_size: int
        batch_size of data
    frequent: int
        How many batches between calculations.
        Defaults to calculating & logging every 50 batches.
    auto_reset: Bool
        Reset the metric after each log, defaults to true.
=cut

has 'batch_size' => (is => 'ro', isa => 'Int', required => 1);
has 'frequent'   => (is => 'ro', isa => 'Int', default  => 50);
has 'init'       => (is => 'rw', isa => 'Int', default  => 0);
has 'tic'        => (is => 'rw', isa => 'Num', default  => 0);
has 'last_count' => (is => 'rw', isa => 'Int', default  => 0);
has 'auto_reset' => (is => 'ro', isa => 'Bool', default  => 1);

method call(AI::MXNet::BatchEndParam $param)
{
    my $count = $param->nbatch;
    if($self->last_count > $count)
    {
        $self->init(0);
    }
    $self->last_count($count);

    if($self->init)
    {
        if(($count % $self->frequent) == 0)
        {
            my $speed = $self->frequent * $self->batch_size / (time - $self->tic);
            if(defined $param->eval_metric)
            {
                my $name_value = $param->eval_metric->get_name_value;
                $param->eval_metric->reset if $self->auto_reset;
                while(my ($name, $value) = each %{ $name_value })
                {
                    AI::MXNet::Logging->info(
                        "Epoch[%d] Batch [%d]\tSpeed: %.2f samples/sec\tTrain-%s=%f",
                        $param->epoch, $count, $speed, $name, $value
                    );
                }
            }
            else
            {
                AI::MXNet::Logging->info(
                    "Iter[%d] Batch [%d]\tSpeed: %.2f samples/sec",
                    $param->epoch, $count, $speed
                );
            }
            $self->tic(time);
        }
    }
    else
    {
        $self->init(1);
        $self->tic(time);
    }
}

*slice = \&call;

package AI::MXNet::ProgressBar;
use Mouse;
extends 'AI::MXNet::Callback';

=head1 NAME

    AI::MXNet::ProgressBar - A callback to show a progress bar.

=head1 DESCRIPTION

    Shows a progress bar.

    Parameters
    ----------
    total: Int
        batch size, default is 1
    length: Int
        the length of the progress bar, default is 80 chars
=cut

has 'length'  => (is => 'ro', isa => 'Int', default => 80);
has 'total'   => (is => 'ro', isa => 'Int', required => 1);

method call(AI::MXNet::BatchEndParam $param)
{
    my $count = $param->nbatch;
    my $filled_len = int(0.5 + $self->length * $count / $self->total);
    my $percents = int(100.0 * $count / $self->total) + 1;
    my $prog_bar = ('=' x $filled_len) . ('-' x ($self->length - $filled_len));
    print "[$prog_bar] $percents%\r";
}

*slice = \&call;

# Just logs the eval metrics at the end of an epoch.
package AI::MXNet::LogValidationMetricsCallback;
use Mouse;
extends 'AI::MXNet::Callback';

=head1 NAME

    AI::MXNet::LogValidationMetricsCallback - A callback to log the eval metrics at the end of an epoch.
=cut

method call(AI::MXNet::BatchEndParam $param)
{
    return unless defined $param->eval_metric;
    my $name_value = $param->eval_metric->get_name_value;
    while(my ($name, $value) = each %{ $name_value })
    {
        AI::MXNet::Logging->info(
            "Epoch[%d] Validation-%s=%f",
            $param->epoch, $name, $value
        );
    }
}

package AI::MXNet::Callback;

method Speedometer(@args)
{
    AI::MXNet::Speedometer->new(
        @args == 3 ?
            (batch_size => $args[0], frequent => $args[1], auto_reset => $args[2])
            : @args == 2 ?
                (batch_size => $args[0], frequent => $args[1])
                    : (batch_size => $args[0])
    )
}

method ProgressBar(@args)
{
    AI::MXNet::ProgressBar->new(
        @args == 2 ? (total => $args[0], 'length' => $args[1]) : (total => $args[0])
    )
}

method LogValidationMetricsCallback()
{
    AI::MXNet::LogValidationMetricsCallback->new
}

1;

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

package AI::MXNet::Context;
use strict;
use warnings;
use Mouse;
use AI::MXNet::Types;
use AI::MXNet::Function::Parameters;
use constant devtype2str => { 1 => 'cpu', 2 => 'gpu', 3 => 'cpu_pinned' };
use constant devstr2type => { cpu => 1, gpu => 2, cpu_pinned => 3 };
around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    return $class->$orig(device_type => $_[0])
        if @_ == 1 and $_[0] =~ /^(?:cpu|gpu|cpu_pinned)$/;
    return $class->$orig(
        device_type => $_[0]->device_type,
        device_id   => $_[0]->device_id
    ) if @_ == 1 and blessed $_[0];
    return $class->$orig(device_type => $_[0], device_id => $_[0])
        if @_ == 2 and $_[0] =~ /^(?:cpu|gpu|cpu_pinned)$/;
    return $class->$orig(@_);
};

has 'device_type' => (
    is => 'rw',
    isa => enum([qw[cpu gpu cpu_pinned]]),
    default => 'cpu'
);

has 'device_type_id' => (
    is => 'rw',
    isa => enum([1, 2, 3]),
    default => sub { devstr2type->{ shift->device_type } },
    lazy => 1
);

has 'device_id' => (
    is => 'rw',
    isa => 'Int',
    default => 0
);

use overload
    '==' => sub {
        my ($self, $other) = @_;
        return 0 unless blessed($other) and $other->isa(__PACKAGE__);
        return "$self" eq "$other";
    },
    '""' => sub {
        my ($self) = @_;
        return sprintf("%s(%s)", $self->device_type, $self->device_id);
    };
=head1 NAME

    AI::MXNet::Context - A device context.
=cut

=head1 DESCRIPTION

    This class governs the device context of AI::MXNet::NDArray objects.
=cut

=head2

    Constructing a context.

    Parameters
    ----------
    device_type : {'cpu', 'gpu'} or Context.
        String representing the device type

    device_id : int (default=0)
        The device id of the device, needed for GPU
=cut

=head2 cpu

    Returns a CPU context.

    Parameters
    ----------
    device_id : int, optional
        The device id of the device. device_id is not needed for CPU.
        This is included to make interface compatible with GPU.

    Returns
    -------
    context : AI::MXNet::Context
        The corresponding CPU context.
=cut

method cpu(Int $device_id=0)
{
    return $self->new(device_type => 'cpu', device_id => $device_id);
}

=head2 gpu

    Returns a GPU context.

    Parameters
    ----------
    device_id : int, optional

    Returns
    -------
    context : AI::MXNet::Context
        The corresponding GPU context.
=cut

method gpu(Int $device_id=0)
{
    return $self->new(device_type => 'gpu', device_id => $device_id);
}

=head2 current_context

    Returns the current context.

    Returns
    -------
    $default_ctx : AI::MXNet::Context
=cut

method current_ctx()
{
    return $AI::MXNet::current_ctx;
}

method deepcopy()
{
    return __PACKAGE__->new(
                device_type => $self->device_type,
                device_id => $self->device_id
    );
}

$AI::MXNet::current_ctx = __PACKAGE__->new(device_type => 'cpu', device_id => 0);

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

package AI::MXNet::Contrib;
use strict;
use warnings;
use AI::MXNet::Contrib::Symbol;
use AI::MXNet::Contrib::NDArray;

sub sym    { 'AI::MXNet::Contrib::Symbol'  }
sub symbol { 'AI::MXNet::Contrib::Symbol'  }
sub nd     { 'AI::MXNet::Contrib::NDArray' }
sub autograd { 'AI::MXNet::Contrib::AutoGrad' }

1;

lib/AI/MXNet/Contrib/AutoGrad.pm  view on Meta::CPAN

package AI::MXNet::Contrib::AutoGrad;
use strict;
use warnings;
use AI::MXNet::Base;
use AI::MXNet::Function::Parameters;
use Scalar::Util qw(blessed);

=head1 NAME

    AI::MXNet::AutoGrad - Autograd for NDArray.
=cut

=head2 set_is_training

    Set status to training/not training. When training, graph will be constructed
    for gradient computation. Operators will also run with ctx.is_train=True. For example,
    Dropout will drop inputs randomly when is_train=True while simply passing through
    if is_train=False.

    Parameters
    ----------
    is_train: bool

    Returns
    -------
    previous state before this set.
=cut


method set_is_training(Bool $is_train)
{
    my $prev = scalar(check_call(AI::MXNetCAPI::AutogradSetIsTraining($is_train ? 1 : 0)));
    return $prev ? 1 : 0
}

=head2 mark_variables

    Mark AI::MXNet::NDArrays as variables to compute gradient for autograd.

    Parameters
    ----------
    variables: array ref of AI::MXNet::NDArrays
    gradients: array ref of AI::MXNet::NDArrays
    grad_reqs: array ref of strings
=cut

method mark_variables(
    ArrayRef[AI::MXNet::NDArray]  $variables,
    ArrayRef[AI::MXNet::NDArray]  $gradients,
    GradReq|ArrayRef[GradReq]     $grad_reqs='write'
)
{
    my @variable_handles = map { $_->handle } @{ $variables };
    my @gradient_handles = map { $_->handle } @{ $gradients };
    my @grad_reqs;
    if(not ref $grad_reqs)
    {
        @grad_reqs = (GRAD_REQ_MAP->{ $grad_reqs }) x scalar(@variable_handles);
    }
    else
    {
        @grad_reqs = map { GRAD_REQ_MAP->{ $_ } } @{ $grad_reqs };
    }
    check_call(
        AI::MXNetCAPI::AutogradMarkVariables(
            scalar(@variable_handles),
            \@variable_handles,
            \@grad_reqs,
            \@gradient_handles
        )
    );
}

=head2 backward

     Compute the gradients of outputs w.r.t variables.

     Parameters
     ----------
     outputs: array ref of NDArray
     out_grads: array ref of NDArray or undef
     retain_graph: bool, defaults to false
=cut


method backward(
    ArrayRef[AI::MXNet::NDArray] $outputs,
    Maybe[ArrayRef[AI::MXNet::NDArray|Undef]] $out_grads=,
    Bool $retain_graph=0
)
{
    my @output_handles = map { $_->handle } @{ $outputs };
    if(not defined $out_grads)
    {
        check_call(
            AI::MXNetCAPI::AutogradBackward(
                scalar(@output_handles),
                \@output_handles,
                [],
                $retain_graph
            )
        );
        return;
    }

    my @ograd_handles;
    for my $arr (@$out_grads)
    {
        push @ograd_handles, (defined $arr ? $arr->handle : undef);
    }
    assert(
        (@ograd_handles == @output_handles),
        "outputs and out_grads must have the same length"
    );

    check_call(
        AI::MXNetCAPI::AutogradBackward(
            scalar(@output_handles),
            \@output_handles,
            \@ograd_handles,
            $retain_graph
        )
    );
}

=head2 compute_gradient

    Compute the gradients of outputs w.r.t variables.

    Parameters
    ----------
    outputs: array ref of NDArray

    Returns
    -------
    gradients: array ref of NDArray
=cut


method compute_gradient(ArrayRef[AI::MXNet::NDArray] $outputs)
{
    __PACKAGE__->backward($outputs);
}

=head2 grad_and_loss

    Return function that computes both gradient of arguments and loss value.

    Parameters
    ----------
    func: a perl sub
        The forward (loss) function.
    argnum: an int or a array ref of int
        The index of argument to calculate gradient for.

    Returns
    -------
    grad_and_loss_func: a perl sub
        A function that would compute both the gradient of arguments and loss value.
=cut

method grad_and_loss(CodeRef $func, Maybe[Int|ArrayRef[Int]] $argnum=)
{
    return sub {
        my @args = @_;
        my @variables = @_;
        if(defined $argnum)
        {
            my @argnum = ref $argnum ? @$argnum : ($argnum);
            @variables = map { $_[$_] } @argnum;
        }
        map {
            assert(
                (blessed($_) and $_->isa('AI::MXNet::NDArray')),
                "type of autograd input should NDArray")
        } @variables;
        my @grads = map { $_->zeros_like } @variables;
        __PACKAGE__->mark_variables(\@variables, \@grads);
        my $prev = __PACKAGE__->set_is_training(1);
        my $outputs = $func->(@args);
        __PACKAGE__->set_is_training(0) unless $prev;
        __PACKAGE__->compute_gradient(ref $outputs eq 'ARRAY' ? $outputs : [$outputs]);
        return (\@grads, $outputs);
    };
}

=head2 grad

    Return function that computes gradient of arguments.

    Parameters
    ----------
    func: a perl sub
        The forward (loss) function.
    argnum: an int or arry ref of int
        The index of argument to calculate gradient for.

    Returns
    -------
    grad_func: a perl function
        A function that would compute the gradient of arguments.
=cut


method grad(CodeRef $func, Maybe[Int|ArrayRef[Int]] $argnum=)
{
    my $grad_with_loss_func = __PACKAGE__->grad_and_loss($func, $argnum);
    return sub {
        return ($grad_with_loss_func->(@_))[0];
    };
}

method train_section(CodeRef $sub)
{
    my $prev = __PACKAGE__->set_is_training(1);
    $sub->();
    __PACKAGE__->set_is_training(0) unless $prev;
}

method test_section(CodeRef $sub)
{
    my $prev = __PACKAGE__->set_is_training(0);
    $sub->();
    __PACKAGE__->set_is_training(1) if $prev;
}

1;

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

package AI::MXNet::Contrib::NDArray;
use strict;
use warnings;

sub AUTOLOAD {
    my $sub = $AI::MXNet::Contrib::NDArray::AUTOLOAD;
    $sub =~ s/.*:://;
    $sub = "_contrib_$sub";
    shift;
    return AI::MXNet::NDArray->$sub(@_);
}

1;

lib/AI/MXNet/Contrib/Symbol.pm  view on Meta::CPAN

package AI::MXNet::Contrib::Symbol;
use strict;
use warnings;

sub AUTOLOAD {
    my $sub = $AI::MXNet::Contrib::Symbol::AUTOLOAD;
    $sub =~ s/.*:://;
    $sub = "_contrib_$sub";
    shift;
    return AI::MXNet::Symbol->$sub(@_);
}

1;

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

package AI::MXNet::Executor;
use strict;
use warnings;
use AI::MXNet::Base;
use AI::MXNet::Context;
use Mouse;
use AI::MXNet::Types;
use AI::MXNet::Function::Parameters;

has 'handle'            => (is => 'ro', isa => 'ExecutorHandle', required => 1);
has 'arg_arrays'        => (is => 'rw', isa => 'Maybe[ArrayRef[AI::MXNet::NDArray]]');
has 'grad_arrays'       => (is => 'rw', isa => 'Maybe[ArrayRef[Undef|AI::MXNet::NDArray]]'); 
has 'aux_arrays'        => (is => 'rw', isa => 'Maybe[ArrayRef[AI::MXNet::NDArray]]');
has '_symbol'           => (is => 'rw', init_arg => 'symbol',    isa => 'AI::MXNet::Symbol');
has '_ctx'              => (is => 'rw', init_arg => 'ctx',       isa => 'AI::MXNet::Context' );
has '_grad_req'         => (is => 'rw', init_arg => 'grad_req',  isa => 'Maybe[Str|ArrayRef[Str]|HashRef[Str]]');
has '_group2ctx'        => (is => 'rw', init_arg => 'group2ctx', isa => 'Maybe[HashRef[AI::MXNet::Context]]');
has '_monitor_callback' => (is => 'rw', isa => 'CodeRef');
has [qw/_arg_dict
        _grad_dict
        _aux_dict
        _output_dict
        outputs
        _output_dirty/] => (is => 'rw', init_arg => undef);
=head1 NAME

    AI::MXNet::Executor - The actual executing object of MXNet.

=head2 new

    Constructor, used by AI::MXNet::Symbol->bind and by AI::MXNet::Symbol->simple_bind.

    Parameters
    ----------
    handle: ExecutorHandle
        ExecutorHandle is generated by calling bind.

    See Also
    --------
    AI::MXNet::Symbol->bind : how to create the AI::MXNet::Executor.
=cut

sub BUILD
{
    my $self = shift;
    my ($symbol, $ctx, $grad_req, $group2ctx)
        =
    ($self->_symbol, $self->_ctx, $self->_grad_req, $self->_group2ctx);
    $symbol = $symbol->deepcopy;
    $ctx    = $ctx->deepcopy;
    if(ref $grad_req)
    {
        if(ref $grad_req eq 'ARRAY')
        {
            $grad_req = [ @{ $grad_req }];
        }
        elsif(ref $grad_req eq 'HASH')
        {
            $grad_req = { %{ $grad_req } };

        }
    }
    if(ref $group2ctx)
    {
        $group2ctx = { %{ $group2ctx } };
    }
    $self->_symbol($symbol);
    $self->_ctx($ctx);
    $self->_grad_req($grad_req);
    $self->_group2ctx($group2ctx);
    $self->outputs($self->_get_outputs);
}

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

# Get the dictionary given name and ndarray pairs.
func _get_dict(
    ArrayRef[Str]                       $names,
    ArrayRef[Maybe[AI::MXNet::NDArray]] $ndarrays
)
{
    my %nset = ();
    for my $nm (@{ $names })
    {
        if(exists $nset{ $nm })
        {
            confess("Duplicate names detected, @$names")
        }
        $nset{ $nm }++;
    }
    my %ret;
    @ret{ @{ $names } } = @{ $ndarrays };
    return \%ret;
}

=head2 outputs

    The output ndarrays bound to this executor.

    Returns
    -------
    An array ref with AI::MXNet::NDArray objects bound to the heads of the executor.
=cut

method _get_outputs()
{
    return [
            map {
                AI::MXNet::NDArray->new(handle => $_)
            }
            @{ check_call(AI::MXNetCAPI::ExecutorOutputs($self->handle)) }
    ];
}

=head2 forward

    Calculate the outputs specified by the bound symbol.

    Parameters
    ----------
    $is_train=0: bool, optional
        whether this forward is for evaluation purpose. If True,
        a backward call is expected to follow. Otherwise following
        backward is invalid.

    %kwargs
        Additional specification of input arguments.

    Examples
    --------
        >>> # doing forward by specifying data
        >>> $texec->forward(1, data => $mydata);
        >>> # doing forward by not specifying things, but copy to the executor before hand
        >>> $mydata->copyto($texec->arg_dict->{'data'});
        >>> $texec->forward(1);
        >>> # doing forward by specifying data and get outputs
        >>> my $outputs = $texec->forward(1, data => $mydata);
        >>> print $outputs->[0]->aspdl;
=cut

method forward(Int $is_train=0, %kwargs)
{
    if(%kwargs)
    {
        my $arg_dict = $self->arg_dict;
        while (my ($name, $array) = each %kwargs)
        {
            if(not find_type_constraint('AcceptableInput')->check($array))
            {
                confess('only accept keyword argument of NDArrays/PDLs/Perl Array refs');
            }
            if(not exists $arg_dict->{ $name })
            {
                confess("unknown argument $name");
            }
            if(not blessed($array) or not $array->isa('AI::MXNet::NDArray'))
            {
                $array = AI::MXNet::NDArray->array($array);
            }
            if(join(',', @{ $arg_dict->{$name}->shape }) ne join(',', @{ $array->shape }))
            {
                my $expected = $arg_dict->{$name}->shape;
                my $got = $array->shape;
                confess("Shape not match! Argument $name, need: @$expected, received: @$got'");
            }
            $arg_dict->{ $name } .= $array;
        }
    }
    check_call(AI::MXNetCAPI::ExecutorForward(
            $self->handle,
            $is_train
        )
    );
    if($self->_output_dirty)
    {
        AI::MXNet::Logging->warning(
            "Calling forward the second time after forward(is_train=1) "
            ."without calling backward first. Is this intended?"
        );
    }
    $self->_output_dirty($is_train);
    return $self->outputs;
}

=head2 backward

    Do a backward pass to get the gradient of the arguments.

    Parameters
    ----------
    out_grads : NDArray or an array ref of NDArrays or hash ref of NDArrays, optional.
        The gradient on the outputs to be propagated back.
        This parameter is only needed when bind is called
        on outputs that are not a loss function.
=cut

method backward(Maybe[AI::MXNet::NDArray|ArrayRef[AI::MXNet::NDArray]|HashRef[AI::MXNet::NDArray]] $out_grads=)
{
    $out_grads //= [];
    if(blessed $out_grads)
    {
        $out_grads = [$out_grads];
    }
    elsif(ref $out_grads eq 'HASH')
    {
        $out_grads = [ @{ $out_grads }{ @{ $self->symbol->list_outputs() } } ];
    }
    check_call(
        AI::MXNetCAPI::ExecutorBackward(
            $self->handle,
            scalar(@{ $out_grads }),
            [map { $_->handle } @{ $out_grads }]
        )
    );
    if(not $self->_output_dirty)
    {
        AI::MXNet::Logging->warning(
            "Calling backward without calling forward(is_train=True) "
            ."first. Behavior is undefined."
        );
    }
    $self->_output_dirty(0);
}

=head2 set_monitor_callback

    Install callback.

    Parameters
    ----------
    callback : subref
        Takes a string and an NDArrayHandle.
=cut

method set_monitor_callback(CodeRef $callback)
{
    $self->_monitor_callback($callback);
    check_call(
        AI::MXNetCAPI::ExecutorSetMonitorCallback(
            $self->handle,
            $self->_monitor_callback
        )
    );
}

=head2 arg_dict

    Get a hash ref representation of the argument arrays.

    Returns
    -------
    arg_dict : HashRef[AI::MXNet::NDArray]
        The map that maps a name of the arguments to the NDArrays.
=cut

method arg_dict()
{
    if(not defined $self->_arg_dict)
    {
        $self->_arg_dict(_get_dict(
                $self->_symbol->list_arguments(),
                $self->arg_arrays
            )
        );
    }
    return $self->_arg_dict;
}

=head2 grad_dict

    Get a hash ref representation of the gradient arrays.

    Returns
    -------
    grad_dict : HashRef[AI::MXNet::NDArray]
        The map that maps a name of the arguments to the gradient NDArrays.
=cut

method grad_dict()
{
    if(not defined $self->_grad_dict)
    {
        $self->_grad_dict(_get_dict(
                $self->_symbol->list_arguments(),
                $self->grad_arrays
            )
        );
    }
    return $self->_grad_dict;
}

=head2 aux_dict

    Get a hash ref representation of the auxiliary states arrays.

    Returns
    -------
    aux_dict : HashRef[AI::MXNet::NDArray]
        The map that maps a name of the auxiliary states to the NDArrays.
=cut

method aux_dict()
{
    if(not defined $self->_aux_dict)
    {
        $self->_aux_dict(_get_dict(
                $self->_symbol->list_auxiliary_states(),
                $self->aux_arrays()
            )
        );
    }
    return $self->_aux_dict;
}

=head2 output_dict

    Get a hash ref representation of the output arrays.

    Returns
    -------
    output_dict : HashRef[AI::MXNet::NDArray]
        The map that maps a name of the outputs to the NDArrays.
=cut

method output_dict()
{
    if(not defined $self->_output_dict)
    {
        $self->_output_dict(_get_dict(
                $self->_symbol->list_outputs(),
                $self->outputs
            )
        );
    }
    return $self->_output_dict;
}

=head2 copy_params_from

    Copy parameters from arg_params, aux_params into the executor's internal array.

    Parameters
    ----------
    arg_params : HashRef[AI::MXNet::NDArray]
        Parameters, hash ref of name to NDArray of arguments

    aux_params : Maybe[HashRef[AI::MXNet::NDArray]], optional
        Parameters, hash ref of name to NDArray of auxiliary states.

    allow_extra_params : boolean, optional
        Whether to allow extra parameters that are not needed by symbol
        If this is True, no error will be thrown when arg_params or aux_params
        contain extra parameters that is not needed by the executor.
=cut

method copy_params_from(
    HashRef[AI::MXNet::NDArray]        $arg_params,
    Maybe[HashRef[AI::MXNet::NDArray]] $aux_params=,
    Maybe[Bool]                        $allow_extra_params=
)
{
    my %arg_dict = %{ $self->arg_dict };
    while (my ($name, $array) = each %{ $arg_params })
    {
        if(exists $arg_dict{ $name })
        {
            my $dst = $arg_dict{ $name };
            $array->astype($dst->dtype)->copyto($dst);
        }
        elsif(not $allow_extra_params)
        {
            confess("Found name \"$name\" that is not in the arguments");
        }
    }
    if(defined $aux_params)
    {
        my %aux_dict = %{ $self->aux_dict };
        while (my ($name, $array) = each %{ $aux_params })
        {
            if(exists $aux_dict{ $name })
            {
                my $dst = $aux_dict{ $name };
                $array->astype($dst->dtype)->copyto($dst);
            }
            elsif(not $allow_extra_params)
            {
                confess("Found name \"$name\" that is not in the arguments");
            }
        }
    }
}

=head2 reshape

    Returns new executor with the same symbol and shared memory,
    but different input/output shapes.
    For runtime reshaping, variable length sequences, etc.
    The returned executor shares state with the current one,
    and cannot be used in parallel with it.

    Parameters
    ----------
    $kwargs : HashRef[Shape]
        new shape for arguments.
    :$partial_shaping : bool
        Whether to allow changing the shape of unspecified arguments.
    :$allow_up_sizing : bool
        Whether to allow allocating new ndarrays that's larger than the original.

    Returns
    -------
    $exec : AI::MXNet::Executor
        A new executor that shares memory with self.
=cut


method reshape(HashRef[Shape] $kwargs, Int :$partial_shaping=0, Int :$allow_up_sizing=0)
{
    my ($arg_shapes, undef, $aux_shapes) = $self->_symbol->infer_shape(%{ $kwargs });
    confess("Insufficient argument shapes provided.") 
        unless defined $arg_shapes;
    my %new_arg_dict;
    my %new_grad_dict;
    my $i = 0;
    for my $name (@{ $self->_symbol->list_arguments() })
    {
        my $new_shape = $arg_shapes->[$i];
        my $arr       = $self->arg_arrays->[$i];
        my $darr;
        if(@{ $self->grad_arrays })
        {
            $darr = $self->grad_arrays->[$i];
        }
        if(
            $partial_shaping
                or
            exists $kwargs->{ $name }
                or
            join(',', @{ $new_shape }) eq join(',', @{ $arr->shape })
        )
        {
            if(AI::MXNet::NDArray->size($new_shape) > $arr->size)
            {
                confess(
                    "New shape of arg:$name larger than original. "
                    ."First making a big executor and then down sizing it "
                    ."is more efficient than the reverse."
                    ."If you really want to up size, set \$allow_up_sizing=1 "
                    ."to enable allocation of new arrays."
                ) unless $allow_up_sizing;
                $new_arg_dict{ $name }  = AI::MXNet::NDArray->empty(
                    $new_shape,
                    ctx => $arr->context,
                    dtype => $arr->dtype
                );
                if(defined $darr)
                {
                    $new_grad_dict{ $name } = AI::MXNet::NDArray->empty(
                        $new_shape,
                        ctx => $darr->context,
                        dtype => $arr->dtype
                    );
                }
            }
            else
            {
                $new_arg_dict{ $name } = $arr->reshape($new_shape);
                if(defined $darr)
                {
                    $new_grad_dict{ $name } = $darr->reshape($new_shape);
                }
            }
        }
        else
        {
            confess(
                    "Shape of unspecified array arg:$name changed. "
                    ."This can cause the new executor to not share parameters "
                    ."with the old one. Please check for error in network."
                    ."If this is intended, set partial_shaping=True to suppress this warning."
            );
        }
        $i++;
    }
    my %new_aux_dict;
    $i = 0;
    for my $name (@{ $self->_symbol->list_auxiliary_states() })
    {
        my $new_shape = $aux_shapes->[$i];
        my $arr = $self->aux_arrays->[$i];
        if($partial_shaping or join(',', @{ $new_shape }) eq join (',', @{ $arr->shape }))
        {
            if(AI::MXNet::NDArray->size($new_shape) > $arr->size)
            {
                confess(
                    "New shape of arg:$name larger than original. "
                    ."First making a big executor and then down sizing it "
                    ."is more efficient than the reverse."
                    ."If you really want to up size, set \$allow_up_sizing=1 "
                    ."to enable allocation of new arrays."
                ) unless $allow_up_sizing;
                $new_aux_dict{ $name }  = AI::MXNet::NDArray->empty(
                    $new_shape,
                    ctx => $arr->context,
                    dtype => $arr->dtype
                );
            }
            else
            {
                $new_aux_dict{ $name } = $arr->reshape($new_shape);
            }
        }
        else
        {
            confess(
                "Shape of unspecified array aux:$name changed. "
                ."This can cause the new executor to not share parameters "
                ."with the old one. Please check for error in network."
                ."If this is intended, set partial_shaping=True to suppress this warning."
            );
        }
        $i++;
    }
    return $self->_symbol->bind(
                ctx         => $self->_ctx,
                args        => \%new_arg_dict,
                args_grad   => \%new_grad_dict,
                grad_req    => $self->_grad_req,
                aux_states  => \%new_aux_dict,
                group2ctx   => $self->_group2ctx,
                shared_exec => $self
    );
}

=head2 debug_str

    A debug string about the internal execution plan.

    Returns
    -------
    debug_str : string
        Debug string of the executor.
=cut

method debug_str()
{
    return scalar(check_call(AI::MXNetCAPI::ExecutorPrint($self->handle)));
}

1;

lib/AI/MXNet/Executor/Group.pm  view on Meta::CPAN

package AI::MXNet::Executor::Group;
use strict;
use warnings;
use Scalar::Util qw(blessed);
use List::Util qw(sum min);
use AI::MXNet::Base;
use AI::MXNet::Function::Parameters;

=head1 NAME

    AI::MXNet::Executor::Group - Manager for a group of executors working in different contexts.
=cut

func _split_input_slice($batch_size, $work_load_list)
{
    my $total_work_load = sum(@{ $work_load_list });
    my @batch_num_list = map { # perl does not have builtin round
        int(($_ * $batch_size / $total_work_load) + 0.5)
    } @{ $work_load_list };
    my $batch_num_sum = sum(@batch_num_list);
    my @slices;
    if($batch_num_sum < $batch_size)
    {
        $batch_num_list[-1] += $batch_size - $batch_num_sum;
    }
    my $end = 0;
    for my $batch_num (@batch_num_list)
    {
        my $begin = int(min($end, $batch_size));
        $end = int(min($begin + $batch_num, $batch_size));
        if($begin >= $end)
        {
            confess('Too many slices such that some splits are empty');
        }
        push @slices, [$begin, $end];
    }
    return \@slices;
}

# Load a array ref of arrays into a array ref of arrays specified by slices
func _load_general($data, $targets, $major_axis)
{
    zip(sub {
        my ($d_src, $d_targets, $axis) = @_;
        if(blessed($d_targets) and $d_targets->isa('AI::MXNet::NDarray'))
        {
            $d_src->copyto($d_targets);
        }
        elsif(ref $d_targets eq 'ARRAY' and blessed $d_targets->[0])
        {
            zip(sub {
                my ($src, $dst) = @_;
                $src->copyto($dst);
            }, $d_src, $d_targets);
        }
        else
        {
            for my $d (@{ $d_targets })
            {
                my ($slice_idx, $d_dst) = @{ $d };
                if($axis >= 0)
                {
                    my $shape = $d_src->shape;
                    my $do_crop = ($slice_idx->[0] != 0 or $shape->[$axis] != $slice_idx->[1]);
                    if($do_crop)
                    {
                        if($axis == 0)
                        {
                            $d_src->slice([$slice_idx->[0], $slice_idx->[1] - 1])->copyto($d_dst);
                        }
                        else
                        {
                            if($d_src->context == $d_dst->context)
                            {
                                AI::MXNet::NDArray->slice_axis(
                                    $d_src,
                                    {
                                        axis  => $axis,
                                        begin => $slice_idx->[0],
                                        end   => $slice_idx->[1],
                                        out   => $d_dst
                                    }
                                );
                            }
                            else
                            {
                                my $d_dst_copy = AI::MXNet::NDArray->slice_axis(
                                    $d_src,
                                    {
                                        axis  => $axis,
                                        begin => $slice_idx->[0],
                                        end   => $slice_idx->[1]
                                    }
                                );
                                $d_dst_copy->copyto($d_dst);
                            }
                        }
                    }
                    else
                    {
                        $d_src->copyto($d_dst);
                    }
                }
                else
                {
                    $d_src->copyto($d_dst);
                }
            }
        }
    }, $data, $targets, $major_axis);
}

# Load data into sliced arrays
func _load_data($batch, $targets, $major_axis)
{
    _load_general($batch->data, $targets, $major_axis);
}

# Load label into sliced arrays
func _load_label($batch, $targets, $major_axis)
{
    _load_general($batch->label, $targets, $major_axis);
}

# Merge outputs that live on multiple context into one, so that they look
# like living on one context.
func _merge_multi_context($outputs, $major_axis)
{
    my @rets;
    zip(sub {
        my ($tensors, $axis) = @_;
        if($axis >= 0)
        {
            if(@$tensors == 1)
            {
                push @rets, $tensors->[0];
            }
            else
            {
                my $ctx = $tensors->[0]->context;
                push @rets, AI::MXNet::NDArray->concat((map { $_->as_in_context($ctx) } @$tensors), { dim => $axis });
            }
        }
        else
        {
            # negative axis means the there is no batch_size axis, and all the
            # results should be the same on each device. We simply take the
            # first one, without checking they are actually the same
            push @rets, $tensors->[0];
        }
    }, $outputs, $major_axis);
    return \@rets;
}

## TODO
## this class is here because of https://github.com/gfx/p5-Mouse/pull/67
## once 2.4.7 version of Mouse in Ubuntu for affected Perl version
## these accessors should be merged into main class
package AI::MXNet::DataParallelExecutorGroup::_private;
use Mouse;
has [qw/output_layouts label_layouts arg_names aux_names
        batch_size slices execs data_arrays
        label_arrays param_arrays grad_arrays aux_arrays
        data_layouts shared_data_arrays input_grad_arrays
        _default_execs state_arrays/
    ] => (is => 'rw', init_arg => undef);

package AI::MXNet::DataParallelExecutorGroup;
use Mouse;
use AI::MXNet::Base;
use List::Util qw(sum);

=head1 DESCRIPTION

    DataParallelExecutorGroup is a group of executors that lives on a group of devices.
    This is a helper class used to implement data parallelization. Each mini-batch will
    be split and run on the devices.

    Parameters for constructor
    ----------
    symbol : AI::MXNet::Symbol
        The common symbolic computation graph for all executors.
    contexts : ArrayRef[AI::MXNet::Context]
        A array ref of contexts.
    workload : ArrayRef[Num]
        If not undef, could be an array ref of numbers that specify the workload to be assigned
        to different context. Larger number indicate heavier workload.
    data_shapes : ArrayRef[NameShape|AI::MXNet::DataDesc]
        Should be a array ref of [name, shape] array refs, for the shapes of data. Note the order is
        important and should be the same as the order that the `DataIter` provide the data.
    label_shapes : Maybe[ArrayRef[NameShape|AI::MXNet::DataDesc]]
        Should be a array ref of [$name, $shape] array refs, for the shapes of label. Note the order is
        important and should be the same as the order that the `DataIter` provide the label.
    param_names : ArrayRef[Str]
        A array ref of strings, indicating the names of parameters (e.g. weights, filters, etc.)
        in the computation graph.
    for_training : Bool
        Indicate whether the executors should be bind for training. When not doing training,
        the memory for gradients will not be allocated.
    inputs_need_grad : Bool
        Indicate whether the gradients for the input data should be computed. This is currently
        not used. It will be useful for implementing composition of modules.
    shared_group : AI::MXNet::DataParallelExecutorGroup
        Default is undef. This is used in bucketing. When not undef, it should be a executor
        group corresponding to a different bucket. In other words, it will correspond to a different
        symbol with the same set of parameters (e.g. unrolled RNNs with different lengths).
        In this case the memory regions of the parameters will be shared.
    logger : Logger
        Default is AI::MXNet::Logging->get_logger.
    fixed_param_names: Maybe[ArrayRef[Str]]
        Indicate parameters to be fixed during training. Parameters in this array ref will not allocate
        space for gradient, nor do gradient calculation.
    grad_req : ArrayRef[GradReq]|HashRef[GradReq]|GradReq
        Requirement for gradient accumulation. Can be 'write', 'add', or 'null'
        (default to 'write').
        Can be specified globally (str) or for each argument (array ref, hash ref).
    state_names: Maybe[ArrayRef[Str]]
=cut

has 'symbol'            => (is => 'ro', isa => 'AI::MXNet::Symbol', required => 1);
has 'contexts'          => (is => 'ro', isa => 'ArrayRef[AI::MXNet::Context]', required => 1);
has 'workload'          => (is => 'ro', isa => 'ArrayRef[Num]', default => sub { [] });
has 'data_shapes'       => (is => 'rw', isa => 'ArrayRef[NameShape|AI::MXNet::DataDesc]', required => 1);
has 'label_shapes'      => (is => 'rw', isa => 'Maybe[ArrayRef[NameShape|AI::MXNet::DataDesc]]');
has 'param_names'       => (is => 'ro', isa => 'ArrayRef[Str]', required => 1);
has 'for_training'      => (is => 'ro', isa => 'Bool', required => 1);
has 'inputs_need_grad'  => (is => 'ro', isa => 'Bool', default  => 0);
has 'shared_group'      => (is => 'ro', isa => 'Maybe[AI::MXNet::DataParallelExecutorGroup]');
has 'logger'            => (is => 'ro', default => sub { AI::MXNet::Logging->get_logger });
has 'fixed_param_names' => (is => 'rw', isa => 'Maybe[ArrayRef[Str]]');
has 'state_names'       => (is => 'rw', isa => 'Maybe[ArrayRef[Str]]');
has 'grad_req'          => (is => 'rw', isa => 'ArrayRef[GradReq]|HashRef[GradReq]|GradReq', default=>'write');
has '_p'                => (is => 'rw', init_arg => undef);
sub BUILD
{
    my $self = shift;
    my $p = AI::MXNet::DataParallelExecutorGroup::_private->new;
    $p->arg_names($self->symbol->list_arguments);
    $p->aux_names($self->symbol->list_auxiliary_states);
    $p->execs([]);
    $self->_p($p);
    $self->grad_req('null') if not $self->for_training;
    $self->fixed_param_names([]) unless defined $self->fixed_param_names;
    $self->state_names([]) unless defined $self->state_names;
    my $data_shapes = [];
    for my $d (@{ $self->data_shapes })
    {
        $d = AI::MXNet::DataDesc->new(name => $d->[0], shape => $d->[1])
            unless blessed $d;
        push @{ $data_shapes }, $d;
    }
    $self->data_shapes($data_shapes);
    if(defined $self->label_shapes)
    {
        my $label_shapes = [];
        for my $l (@{ $self->label_shapes })
        {
            $l = AI::MXNet::DataDesc->new(name => $l->[0], shape => $l->[1])
                unless blessed $l;
            push @{ $label_shapes }, $l;
        }
        $self->label_shapes($label_shapes);
    }
    my %data_names  = map { $_->name => 1 } @{ $self->data_shapes };
    my %param_names = map { $_    =>    1 } @{ $self->param_names };
    my %fixed_param_names = map { $_ => 1 } @{ $self->fixed_param_names };
    my %grad_req;
    if(not ref $self->grad_req)
    {
        for my $k (@{ $self->_p->arg_names })
        {
            if(exists $param_names{ $k })
            {
                $grad_req{$k} = exists $fixed_param_names{ $k } ? 'null' : $self->grad_req;
            }
            elsif(exists $data_names{ $k })
            {
                $grad_req{$k} = $self->inputs_need_grad ? $self->grad_req : 'null';
            }
            else
            {
                $grad_req{$k} = 'null';
            }
        }
    }
    elsif(ref $self->grad_req eq 'ARRAY')
    {
        @grad_req{ @{ $self->_p->arg_names } } = @{ $self->grad_req };
    }
    else
    {
        for my $k (@{ $self->_p->arg_names })
        {
            if(exists $param_names{ $k })
            {
                $grad_req{$k} = exists $fixed_param_names{ $k } ? 'null' : 'write';
            }
            elsif(exists $data_names{ $k })
            {
                $grad_req{$k} = $self->inputs_need_grad ? 'write' : 'null';
            }
            else
            {
                $grad_req{$k} = 'null';
            }
        }
        %grad_req = (%grad_req, %{ $self->grad_req });
    }
    $self->grad_req(\%grad_req);
    if(defined $self->shared_group)
    {
        $self->_p->shared_data_arrays($self->shared_group->_p->shared_data_arrays);
    }
    else
    {
        $self->_p->shared_data_arrays([map { +{} } 0..@{ $self->contexts }-1]);
    }
    $self->_p->output_layouts([
        map {
            AI::MXNet::DataDesc->get_batch_axis($self->symbol->slice($_)->attr('__layout__'))
        } @{ $self->symbol->list_outputs }
    ]);
    $self->bind_exec($self->data_shapes, $self->label_shapes, $self->shared_group);
}

=decide_slices

    Decide the slices for each context according to the workload.

    Parameters
    ----------
    $data_shapes : ArrayRef[AI::MXNet::DataDesc]
=cut

method decide_slices(ArrayRef[AI::MXNet::DataDesc] $data_shapes)
{
    confess("empty data_shapes array") unless @{ $data_shapes } > 0;
    my $major_axis = [map { AI::MXNet::DataDesc->get_batch_axis($_->layout) } @{ $data_shapes }];
    zip(sub {
        my ($desc, $axis) = @_;
        return if($axis == -1);
        my $batch_size = $desc->shape->[$axis];
        if(defined $self->_p->batch_size)
        {
            confess(
                "all data must have the same batch size: "
                . sprintf("batch_size = %d, but ", $self->_p->batch_size)
                . sprintf("%s has shape %s", $desc->name, '('. join(',', @{ $desc->shape }) . ')')
            ) unless $batch_size == $self->_p->batch_size;
        }
        else
        {
            $self->_p->batch_size($batch_size);
            $self->_p->slices(AI::MXNet::Executor::Group::_split_input_slice($self->_p->batch_size, $self->workload));
        }
    }, $data_shapes, $major_axis);
    return $major_axis;
}

# Collect internal arrays from executors.
method _collect_arrays()
{
    # convenient data structures
    $self->_p->data_arrays([]);
    for my $d (@{ $self->data_shapes })
    {
        my $name = $d->name;
        my @tmp;
        for my $i (0..@{ $self->_p->execs }-1)
        {
            push @tmp, [ $self->_p->slices->[$i], $self->_p->execs->[$i]->arg_dict->{$name} ];
        }
        push @{ $self->_p->data_arrays }, \@tmp;
    }
    if(defined $self->label_shapes)
    {
        $self->_p->label_arrays([]);
        for my $l (@{ $self->label_shapes })
        {
            my $name = $l->name;
            my @tmp;
            for my $i (0..@{ $self->_p->execs }-1)
            {
                push @tmp, [ $self->_p->slices->[$i], $self->_p->execs->[$i]->arg_dict->{$name} ];
            }
            push @{ $self->_p->label_arrays }, \@tmp;
        }
    }
    $self->_p->param_arrays([]);
    my %param_names = map { $_ => 1 } @{ $self->param_names };
    for my $i (0..@{ $self->_p->arg_names }-1)
    {
        my $name = $self->_p->arg_names->[$i];
        if(exists $param_names{$name})
        {
            my @tmp;
            for my $exec (@{ $self->_p->execs })
            {
                push @tmp, $exec->arg_arrays->[$i];
            }
            push @{ $self->_p->param_arrays }, \@tmp;
        }
    }
    $self->_p->state_arrays([]);
    for my $i (0..@{ $self->state_names }-1)
    {
        my $name = $self->state_names->[$i];
        my @tmp;
        for my $exec (@{ $self->_p->execs })
        {
            push @tmp, $exec->arg_dict->{$name};
        }
        push @{ $self->_p->state_arrays }, \@tmp;
    }
    if($self->for_training)
    {
        $self->_p->grad_arrays([]);
        for my $i (0..@{ $self->_p->arg_names }-1)
        {
            my $name = $self->_p->arg_names->[$i];
            if(exists $param_names{$name})
            {
                my @tmp;
                for my $exec (@{ $self->_p->execs })
                {
                    push @tmp, $exec->grad_arrays->[$i];
                }
                push @{ $self->_p->grad_arrays }, \@tmp;
            }
        }
    }
    my @data_names = map { $_->name } @{ $self->data_shapes };
    my $j = 0; my %arg_names  = map { $_ => $j++ } @{ $self->_p->arg_names };
    if($self->inputs_need_grad)
    {
        $self->_p->input_grad_arrays([]);
        for my $name (@data_names)
        {
            next unless exists $arg_names{$name};
            my @tmp;
            for my $exec (@{ $self->_p->execs })
            {
                push @tmp, $exec->grad_arrays->[$arg_names{$name}];
            }
            push @{ $self->_p->input_grad_arrays }, \@tmp;
        }
    }
    $self->_p->aux_arrays([]);
    for my $i (0..@{ $self->_p->aux_names }-1)
    {
        my @tmp;
        for my $exec (@{ $self->_p->execs })
        {
            push @tmp, $exec->aux_arrays->[$i];
        }
        push @{ $self->_p->aux_arrays }, \@tmp;
    }
}

=head2 bind_exec

    Bind executors on their respective devices.

    Parameters
    ----------
    $data_shapes  : ArrayRef[AI::MXNet::DataDesc]
    $label_shapes : Maybe[ArrayRef[AI::MXNet::DataDesc]]
    $shared_group : Maybe[AI::MXNet::DataParallelExecutorGroup]
    $reshape      : Bool
=cut

method bind_exec(
    ArrayRef[AI::MXNet::DataDesc]               $data_shapes,
    Maybe[ArrayRef[AI::MXNet::DataDesc]]        $label_shapes=,
    Maybe[AI::MXNet::DataParallelExecutorGroup] $shared_group=,
    Bool                                        $reshape=0
)
{
    assert($reshape or not @{ $self->_p->execs });
    $self->_p->batch_size(undef);

    # calculate workload and bind executors
    $self->_p->data_layouts($self->decide_slices($data_shapes));
    # call it to make sure labels has the same batch size as data
    if(defined $label_shapes)
    {
        $self->_p->label_layouts($self->decide_slices($label_shapes));
    }

    for my $i (0..@{ $self->contexts }-1)
    {
        my $data_shapes_i = $self->_sliced_shape($data_shapes, $i, $self->_p->data_layouts);
        my $label_shapes_i = [];
        if(defined $label_shapes)
        {
            $label_shapes_i = $self->_sliced_shape($label_shapes, $i, $self->_p->label_layouts);
        }
        if($reshape)
        {
            my %combined_hash = map { $_->name => $_->shape } (@{ $data_shapes_i }, @{ $label_shapes_i });
            $self->_p->execs->[$i] = $self->_p->_default_execs->[$i]->reshape(
                \%combined_hash,
                allow_up_sizing => 1,
            );
        }
        else
        {
            push @{ $self->_p->execs }, $self->_bind_ith_exec($i, $data_shapes_i, $label_shapes_i, $shared_group);
        }
    }
    $self->data_shapes($data_shapes);
    $self->label_shapes($label_shapes);
    $self->_collect_arrays;
}

=head2 reshape

    Reshape executors.

    Parameters
    ----------
    $data_shapes : ArrayRef[AI::MXNet::DataDesc]
    $label_shapes : Maybe[ArrayRef[AI::MXNet::DataDesc]]
=cut


method reshape(
    ArrayRef[AI::MXNet::DataDesc]          $data_shapes,
    Maybe[ArrayRef[AI::MXNet::DataDesc]]   $label_shapes=
)
{
    return if($data_shapes eq $self->data_shapes and $label_shapes eq $self->label_shapes);
    if (not defined $self->_p->_default_execs)
    {
        $self->_p->_default_execs([@{ $self->_p->execs }]);
    }
    $self->bind_exec($data_shapes, $label_shapes, undef, 1);
}

=head2 set_params

    Assign, i.e. copy parameters to all the executors.

    Parameters
    ----------
    $arg_params : HashRef[AI::MXNet::NDArray]
        A dictionary of name to AI::MXNet::NDArray parameter mapping.
    $aux_params : HashRef[AI::MXNet::NDArray]
        A dictionary of name to AI::MXNet::NDArray auxiliary variable mapping.
=cut

method set_params(HashRef[AI::MXNet::NDArray] $arg_params, HashRef[AI::MXNet::NDArray] $aux_params, Bool $allow_extra=0)
{
    $_->copy_params_from($arg_params, $aux_params, $allow_extra) for @{ $self->_p->execs };
}

=head2 get_params

    Copy data from each executor to arg_params and aux_params.

    Parameters
    ----------
    $arg_params : HashRef[AI::MXNet::NDArray]
        target parameter arrays
    $aux_params : HashRef[AI::MXNet::NDArray]
        target aux arrays

    Notes
    -----
    - This function will inplace update the NDArrays in arg_params and aux_params.
=cut

method get_params(HashRef[AI::MXNet::NDArray] $arg_params, HashRef[AI::MXNet::NDArray] $aux_params)
{
    my $weight = 0;
    zip(sub {
        my ($name, $block) = @_;
            my $weight = sum(map { $_->copyto(AI::MXNet::Context->cpu) } @{ $block }) / @{ $block };
            $weight->astype($arg_params->{$name}->dtype)->copyto($arg_params->{$name});
    }, $self->param_names, $self->_p->param_arrays);
    zip(sub {
        my ($name, $block) = @_;
            my $weight = sum(map { $_->copyto(AI::MXNet::Context->cpu) } @{ $block }) / @{ $block };
            $weight->astype($aux_params->{$name}->dtype)->copyto($aux_params->{$name});
    }, $self->_p->aux_names, $self->_p->aux_arrays);
}



method get_states($merge_multi_context=1)
{
    assert((not $merge_multi_context), "merge_multi_context=True is not supported for get_states yet.");
    return $self->_p->state_arrays;
}

method set_states($states, $value)
{
    if(defined $states)
    {
        assert((not defined $value), "Only one of states & value can be specified.");
        AI::MXNet::Executor::Group::_load_general($states, $self->_p->state_arrays, [(0)x@{ $states }]);
    }
    else
    {
        assert((defined $value), "At least one of states & value must be specified.");
        assert((not defined $states), "Only one of states & value can be specified.");
        for my $d_dst (@{ $self->_p->state_arrays })
        {
            for my $dst (@{ $d_dst })
            {
                $dst .= $value;
            }
        }
    }
}

=head2 forward

    Split the data_batch according to a workload and run forward on each devices.

    Parameters
    ----------
    data_batch : AI::MXNet::DataBatch
    Or could be any object implementing similar interface.

    is_train : bool
    The hint for the backend, indicating whether we are during training phase.
    Default is undef, then the value $self->for_training will be used.
=cut


method forward(AI::MXNet::DataBatch $data_batch, Maybe[Bool] $is_train=)
{
    AI::MXNet::Executor::Group::_load_data($data_batch, $self->_p->data_arrays, $self->_p->data_layouts);
    $is_train //= $self->for_training;
    if(defined $self->_p->label_arrays)
    {
        confess("assert not is_train or data_batch.label")
            unless (not $is_train or $data_batch->label);
        if($data_batch->label)
        {
            AI::MXNet::Executor::Group::_load_label($data_batch, $self->_p->label_arrays, $self->_p->label_layouts);
        }
    }
    $_->forward($is_train) for @{ $self->_p->execs };
}

# Get the shapes of the outputs

method get_output_shapes()
{
    my @shapes = map { $_->shape } @{ $self->execs->[0]->outputs };
    my @concat_shapes;
    zip(sub {
        my ($key, $shape, $axis) = @_;
        my @the_shape = @{ $shape };
        if($axis >= 0)
        {
            $the_shape[$axis] = $self->_p->batch_size;
        }
        push @concat_shapes, AI::MXNet::DataDesc->new(name => $key, shape => \@the_shape);
    }, $self->symbol->list_outputs, \@shapes, $self->_p->output_layouts);
    return \@concat_shapes;
}

=head2 get_outputs

    Gets outputs of the previous forward computation.

    Parameters
    ----------
    merge_multi_context : bool
    Default is 1. In the case when data-parallelism is used, the outputs
    will be collected from multiple devices. A 1 value indicates that we
    should merge the collected results so that they look like from a single
    executor.

    Returns
    -------
    If merge_multi_context is 1, it is [$out1, $out2]. Otherwise, it
    is [[$out1_dev1, $out1_dev2], [$out2_dev1, $out2_dev2]]. All the output
    elements are `AI::MXNet::NDArray`.
=cut

method get_outputs(Bool $merge_multi_context=1)
{
    my $outputs;
    for my $i (0..@{ $self->_p->execs->[0]->outputs }-1)
    {
        my @tmp;
        for my $exec (@{ $self->_p->execs })
        {
            push @tmp, $exec->outputs->[$i];
        }
        push @$outputs, \@tmp;
    }
    if($merge_multi_context)
    {
        $outputs = AI::MXNet::Executor::Group::_merge_multi_context($outputs, $self->_p->output_layouts);
    }
    return $outputs;
}

=head2  get_input_grads

    Get the gradients with respect to the inputs of the module.

    Parameters
    ----------
    merge_multi_context : bool
    Default is 1. In the case when data-parallelism is used, the outputs
    will be collected from multiple devices. A 1 value indicates that we
    should merge the collected results so that they look like from a single
    executor.

    Returns
    -------
    If merge_multi_context is 1, it is [$grad1, $grad2]. Otherwise, it
    is [[$grad1_dev1, $grad1_dev2], [$grad2_dev1, $grad2_dev2]]. All the output
    elements are AI::MXNet::NDArray.
=cut

method get_input_grads(Bool $merge_multi_context=1)
{
    confess("assert \$self->inputs_need_grad") unless $self->inputs_need_grad;
    if($merge_multi_context)
    {
        return AI::MXNet::Executor::Group::_merge_multi_context($self->_p->input_grad_arrays, $self->_p->data_layouts);
    }
    return $self->_p->input_grad_arrays;
}

=head2 backward

    Run backward on all devices. A backward should be called after
    a call to the forward function. Backward cannot be called unless
    $self->for_training is 1.

    Parameters
    ----------
    out_grads : NDArray or array ref of NDArray, optional
    Gradient on the outputs to be propagated back.
    This parameter is only needed when bind is called
    on outputs that are not a loss function.
=cut

method backward(Maybe[AI::MXNet::NDArray|ArrayRef[AI::MXNet::NDArray]] $out_grads=)
{
    confess('re-bind with for_training=1 to run backward') unless $self->for_training;
    $out_grads //= [];
    zip(sub {
        my ($i, $exec, $islice) = @_;
        my @out_grads_slice;
        zip(sub{
            my ($grad, $axis) = @_;
            if($axis >= 0)
            {
                my $og_my_slice = $grad->slice_axis({
                    axis  => $axis,
                    begin => $islice->[0],
                    end   => $islice->[1]
                });
                push @out_grads_slice, $og_my_slice->as_in_context($self->contexts->[$i]);
            }
            else
            {
                push @out_grads_slice, $grad->copyto($self->contexts->[$i]);
            }
        }, $out_grads, $self->_p->output_layouts);
        $exec->backward(\@out_grads_slice);
    }, [0..@{ $self->_p->execs }-1], $self->_p->execs, $self->_p->slices);
}

=head2 update_metric

    Accumulate the performance according to eval_metric on all devices.

    Parameters
    ----------
    eval_metric : AI::MXNet::EvalMetric
        The metric used for evaluation.
    labels : array ref of NDArray
        Typically comes from label of AI::MXNet::DataBatch.
=cut

method update_metric(AI::MXNet::EvalMetric $eval_metric, ArrayRef[AI::MXNet::NDArray] $labels)
{
    zip(sub {
        my ($texec, $islice) = @_;
        my @labels_slice;
        zip(sub {
            my ($label, $axis) = @_;
            if($axis == 0)
            {
                # slicing NDArray along axis 0 can avoid copying
                push @labels_slice, $label->slice([$islice->[0], $islice->[1]-1]);
            }
            elsif($axis > 0)
            {
                my $label_my_slice = $label->slice_axis({
                    axis  => $axis,
                    begin => $islice->[0],
                    end   => $islice->[1]
                })->as_in_context($label->context);
                push @labels_slice, $label_my_slice;
            }
            else
            {
                push @labels_slice, $label;
            }
        }, $labels, $self->_p->label_layouts);
        $eval_metric->update(\@labels_slice, $texec->outputs);
    }, $self->_p->execs, $self->_p->slices);
}

method _bind_ith_exec(
    Int                                         $i,
    ArrayRef[AI::MXNet::DataDesc]               $data_shapes,
    Maybe[ArrayRef[AI::MXNet::DataDesc]]        $label_shapes,
    Maybe[AI::MXNet::DataParallelExecutorGroup] $shared_group
)
{
    my $shared_exec = $shared_group ? $shared_group->_p->execs->[$i] : undef;
    my $context = $self->contexts->[$i];
    my $shared_data_arrays = $self->_p->shared_data_arrays->[$i];
    my %input_shapes = map { $_->name => $_->shape } @{ $data_shapes };
    if(defined $label_shapes)
    {
        %input_shapes = (%input_shapes, map { $_->name => $_->shape } @{ $label_shapes });
    }
    my %input_types = map { $_->name => $_->dtype } @{ $data_shapes };
    my $executor = $self->symbol->simple_bind(
        ctx              => $context,
        grad_req         => $self->grad_req,
        type_dict        => \%input_types,
        shared_arg_names => $self->param_names,
        shared_exec      => $shared_exec,
        shared_buffer    => $shared_data_arrays,
        shapes           => \%input_shapes
    );
    return $executor;
}

=head2 _sliced_shape

    Get the sliced shapes for the i-th executor.

    Parameters
    ----------
    shapes : array ref of (str, array ref)
        The original (name, shape) pairs.
    i : int
    Which executor we are dealing with.
=cut

method _sliced_shape(ArrayRef[AI::MXNet::DataDesc] $shapes, Int $i, ArrayRef[Int] $major_axis)
{
    my @sliced_shapes;
    zip(sub {
        my ($desc, $axis) = @_;
        my @shape = @{ $desc->shape };
        if($axis >= 0)
        {
            $shape[$axis] = $self->_p->slices->[$i]->[1] - $self->_p->slices->[$i]->[0];
        }
        push @sliced_shapes, AI::MXNet::DataDesc->new(
            name    => $desc->name,
            shape   => \@shape,
            dtype   => $desc->dtype,
            layout  => $desc->layout
        );
    }, $shapes, $major_axis);
    return \@sliced_shapes;
}

=head2 install_monitor

    Install monitor on all executors

    Parameters
    ----------
    $mon : AI::MXNet::Monitor
=cut

method install_monitor(AI::MXNet::Monitor $mon)
{
    $mon->install($_) for @{ $self->_p->execs };
}

method shared_data_arrays()
{
    $self->_p->shared_data_arrays;
}

method execs()
{
    $self->_p->execs;
}

1;

lib/AI/MXNet/Function/Parameters.pm  view on Meta::CPAN

package AI::MXNet::Function::Parameters;
use strict;
use warnings;
use Function::Parameters ();
use AI::MXNet::Types ();
sub import {
    Function::Parameters->import(
        {
            func => {
                defaults => 'function_strict',
                runtime  => 1,
                reify_type => sub {
                    Mouse::Util::TypeConstraints::find_or_create_isa_type_constraint($_[0])
                }
            },
            method => {
                defaults => 'method_strict',
                runtime  => 1,
                reify_type => sub {
                    Mouse::Util::TypeConstraints::find_or_create_isa_type_constraint($_[0])
                }
            },
        }
    );
}

{
    no warnings 'redefine';
    *Function::Parameters::_croak = sub {
        local($Carp::CarpLevel) = 1;
        Carp::confess ("@_");
    };
}

1;

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

package AI::MXNet::IO;
use strict;
use warnings;
use AI::MXNet::Base;
use AI::MXNet::Function::Parameters;
use Scalar::Util qw/blessed/;

=head1 NAME

    AI::MXNet::IO - NDArray interface of mxnet.
=cut

# Convert data into canonical form.
method init_data(
    AcceptableInput|HashRef[AcceptableInput]|ArrayRef[AcceptableInput]|Undef $data,
    Undef|Int :$allow_empty=,
    Str :$default_name
)
{
    Carp::confess("data must be defined or allow_empty set to true value")
        if(not defined $data and not $allow_empty);
    $data //= [];

    if(ref($data) and ref($data) ne 'ARRAY' and ref($data) ne 'HASH')
    {
        $data = [$data];
    }

    Carp::confess("data must not be empty or allow_empty set to true value")
        if(ref($data) eq 'ARRAY' and not @{ $data } and not $allow_empty);

    my @ret;
    if(ref($data) eq 'ARRAY')
    {
        if(@{ $data } == 1)
        {
            @ret = ([$default_name, $data->[0]]);
        }
        else
        {
            my $i = -1;
            @ret = map { $i++; ["_${i}_$default_name", $_] } @{ $data };
        }
    }
    if(ref($data) eq 'HASH')
    {
        while(my ($k, $v) = each %{ $data })
        {
            push @ret, [$k, $v];
        }
    }
    for my $d (@ret)
    {
        if(not (blessed $d->[1] and $d->[1]->isa('AI::MXNet::NDArray')))
        {
            $d->[1] = AI::MXNet::NDArray->array($d->[1]);
        }
    }
    return \@ret;
}

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

package AI::MXNet::DataDesc;
use Mouse;
use overload '""'  => \&stringify,
             '@{}' => \&to_nameshape;
has 'name'   => (is => 'ro', isa => "Str",   required => 1);
has 'shape'  => (is => 'ro', isa => "Shape", required => 1);
has 'dtype'  => (is => 'ro', isa => "Dtype", default => 'float32');
has 'layout' => (is => 'ro', isa => "Str",   default => 'NCHW');

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    if(@_ >= 2 and ref $_[1] eq 'ARRAY')
    {
        my $name  = shift;
        my $shape = shift;
        return $class->$orig(name => $name, shape => $shape, @_);
    }
    return $class->$orig(@_);
};

method stringify($other=, $reverse=)
{
    sprintf(
        "DataDesc[%s,%s,%s,%s]",
        $self->name,
        join('x', @{ $self->shape }),
        $self->dtype,
        $self->layout
    );
}

method to_nameshape($other=, $reverse=)
{
    [$self->name, $self->shape];
}

=head1 NAME

    AI::MXNet::DataDesc - A container class for describing the data layout.
=cut

=head2 get_batch_axis

    Get the dimension that corresponds to the batch size.

    Parameters
    ----------
    layout : str
        layout string. For example, "NCHW".

    Returns
    -------
    An axis indicating the batch_size dimension. When data-parallelism is
    used, the data will be automatically split and concatenate along the batch_size
    dimension. Axis can be -1, which means the whole array will be copied for each
    data-parallelism device.
=cut

method get_batch_axis(Str|Undef $layout)
{
    return 0 unless defined $layout;
    return index($layout, 'N');
}

=head2 get_list

    Coverts the input to an array ref AI::MXNet::DataDesc objects.

    Parameters
    ----------
    $shapes : HashRef[Shape]
    $types= :  Maybe[HashRef[Dtype]]
=cut

method get_list(HashRef[Shape] $shapes, Maybe[HashRef[Dtype]] $types=)
{
    $types //= {};
    return [
        map {
            AI::MXNet::DataDesc->new(
                name  => $_,
                shape => $shapes->{$_},
                (exists $types->{$_} ? (type => $types->{$_}) : ())
            )
        } keys %{ $shapes }
    ];
}

package AI::MXNet::DataBatch;
use Mouse;

=head1 NAME

    AI::MXNet::DataBatch - A container for a mini-batch of the data and related information.
=cut

=head1 DESCRIPTION

    Default object for holding a mini-batch of data and related information.
=cut

has 'data'          => (is => 'rw', isa => 'Maybe[ArrayRef[AI::MXNet::NDArray]]', required => 1);
has 'label'         => (is => 'rw', isa => 'Maybe[ArrayRef[AI::MXNet::NDArray]]');
has 'pad'           => (is => 'rw');
has 'index'         => (is => 'rw');
has 'bucket_key'    => (is => 'rw');
has 'provide_data'  => (is => 'rw');
has 'provide_label' => (is => 'rw');

package AI::MXNet::DataIter;
use Mouse;
use overload '<>' =>  sub { shift->next },
             '@{}' => sub { shift->list };

=head1 NAME

    AI::MXNet::DataIter - A parent class for MXNet data iterators.
=cut

has 'batch_size' => (is => 'rw', isa => 'Int', default => 0);

=head2 reset

    Reset the iterator.
=cut

method reset(){}

=head2 list

    Returns remaining iterator items as an array ref.
=cut

method list()
{
    my @ret;
    while(<$self>)
    {
        push @ret, $_;
    }
    return \@ret;
}

=head2 next

    Returns the next data batch from the iterator.

    Returns
    -------
    $data : AI::MXNet::DataBatch
    The data of next batch.
=cut

method next()
{
    if($self->iter_next())
    {
        return AI::MXNet::DataBatch->new(
            data  => $self->getdata,
            label => $self->getlabel,
            pad   => $self->getpad,
            index => $self->getindex
        );
    }
    else
    {
        return undef;
    }
}

=head2 iter_next

    Iterate to next batch.

    Returns
    -------
    $has_next : Bool
=cut

method iter_next(){}

=head2 get_data

    The data of current batch.

    Returns
    -------
    data : AI::MXNet::NDArray
=cut

method get_data(){}

=head2 getlabel

    The label of the current batch.

    Returns
    -------
    label : AI::MXNet::NDArray
=cut

method getlabel(){}

=head2 getindex

    The index of the current batch.

    Returns
    -------
    $index : PDL
=cut

method getindex(){}

=head2 getpad

    The number of padding examples in the current batch.

    Returns
    -------
    $pad : Int
=cut

method getpad(){}

package AI::MXNet::ResizeIter;
use Mouse;

extends 'AI::MXNet::DataIter';

=head1 NAME

    AI::MXNet::ResizeIter
=cut

=head1 DESCRIPTION

    Resize a DataIter to a given number of batches per epoch.
    May produce incomplete batch in the middle of an epoch due
    to the padding from internal iterator.

    Parameters
    ----------
    data_iter : DataIter
        Internal data iterator.
    size : number of batches per epoch to resize to.
    reset_internal : whether to reset internal iterator on ResizeIter.reset
=cut

has 'data_iter'      => (is => 'ro', isa => 'AI::MXnet::DataIter', required => 1);
has 'size'           => (is => 'ro', isa => 'Int', required => 1);
has 'reset_internal' => (is => 'rw', isa => 'Int', default => 1);
has 'cur'            => (is => 'rw', isa => 'Int', default => 0);
has 'current_batch'  => (is => 'rw', isa => 'Maybe[AI::MXNet::DataBatch]');
has [qw/provide_data
    default_bucket_key
    provide_label
    batch_size/]     => (is => 'rw', init_arg => undef);

sub BUILD
{
    my $self = shift;
    $self->provide_data($self->data_iter->provide_data);
    $self->provide_label($self->data_iter->provide_label);
    $self->batch_size($self->data_iter->batch_size);
    if($self->data_iter->can('default_bucket_key'))
    {
        $self->default_bucket_key($self->data_iter->default_bucket_key);
    }
}

method reset()
{
    $self->cur(0);
    if($self->reset_internal)
    {
        $self->data_iter->reset;
    }
}

method iter_next()
{
    return 0 if($self->cur == $self->size);
    $self->current_batch($self->data_iter->next);
    if(not defined $self->current_batch)
    {
        $self->data_iter->reset;
        $self->current_batch($self->data_iter->next);
    }
    $self->cur($self->cur + 1);
    return 1;
}

method get_data()
{
    return $self->current_batch->data;
}

method getlabel()
{
    return $self->current_batch->label;
}

method getindex()
{
    return $self->current_batch->index;
}

method getpad()
{
    return $self->current_batch->pad;
}

package AI::MXNet::NDArrayIter;
use Mouse;
use AI::MXNet::Base;
use List::Util qw(shuffle);
extends 'AI::MXNet::DataIter';

=head1 NAME

    AI::MXNet::NDArrayIter - Predefined NDArray iterator.
=cut

=head1 DESCRIPTION

    Predefined NDArray iterator. Accepts PDL or AI::MXNet::NDArray object as an input.

    Parameters
    ----------
    data: Maybe[AcceptableInput|HashRef[AcceptableInput]|ArrayRef[AcceptableInput]].
        NDArrayIter supports single or multiple data and label.
    label: Maybe[AcceptableInput|HashRef[AcceptableInput]|ArrayRef[AcceptableInput]].
        Same as data, but is not given to the model during testing.
    batch_size=1: Int
        Batch Size
    shuffle=0: Bool
        Whether to shuffle the data
    last_batch_handle='pad': 'pad', 'discard' or 'roll_over'
        How to handle the last batch

    Note
    ----
    This iterator will pad, discard or roll over the last batch if
    the size of data does not match batch_size. Roll over is intended
    for training and can cause problems if used for prediction.
=cut

has 'data'                => (is => 'rw', isa => 'Maybe[AcceptableInput|HashRef[AcceptableInput]|ArrayRef[AcceptableInput]]');
has 'data_list'           => (is => 'rw', isa => 'ArrayRef[AI::MXNet::NDArray]');
has 'label'               => (is => 'rw', isa => 'Maybe[AcceptableInput|HashRef[AcceptableInput]|ArrayRef[AcceptableInput]]');
has 'batch_size'          => (is => 'rw', isa => 'Int', default => 1);
has '_shuffle'            => (is => 'rw', init_arg => 'shuffle', isa => 'Bool', default => 0);
has 'last_batch_handle'   => (is => 'rw', isa => 'Str', default => 'pad');
has 'label_name'          => (is => 'rw', isa => 'Str', default => 'softmax_label');
has 'num_source'          => (is => 'rw', isa => 'Int');
has 'cursor'              => (is => 'rw', isa => 'Int');
has 'num_data'            => (is => 'rw', isa => 'Int');

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    if(@_%2)
    {
        my $data  = shift;
        return $class->$orig(data => $data, @_);
    }
    return $class->$orig(@_);
};

sub BUILD
{
    my $self  = shift;
    my $data  = AI::MXNet::IO->init_data($self->data,  allow_empty => 0, default_name => 'data');
    my $label = AI::MXNet::IO->init_data($self->label, allow_empty => 1, default_name => $self->label_name);
    my $num_data  = $data->[0][1]->shape->[0];
    confess("size of data dimension 0 $num_data < batch_size ${\ $self->batch_size }")
        unless($num_data >= $self->batch_size);
    if($self->_shuffle)
    {
        my @idx = shuffle(0..$num_data-1);
        $_->[1] = AI::MXNet::NDArray->array(pdl_shuffle($_->[1]->aspdl, \@idx)) for @$data;
        $_->[1] = AI::MXNet::NDArray->array(pdl_shuffle($_->[1]->aspdl, \@idx)) for @$label;
    }
    if($self->last_batch_handle eq 'discard')
    {
        my $new_n = $num_data - $num_data % $self->batch_size - 1;
        $_->[1] = $_->[1]->slice([0, $new_n]) for @$data;
        $_->[1] = $_->[1]->slice([0, $new_n]) for @$label;
    }
    my $data_list  = [map { $_->[1] } (@{ $data }, @{ $label })];
    my $num_source = @{ $data_list };
    my $cursor = -$self->batch_size;
    $self->data($data);
    $self->data_list($data_list);
    $self->label($label);
    $self->num_source($num_source);
    $self->cursor($cursor);
    $self->num_data($num_data);
}

# The name and shape of data provided by this iterator
method provide_data()
{
    return [map {
        my ($k, $v) = @{ $_ };
        my $shape = $v->shape;
        $shape->[0] = $self->batch_size;
        AI::MXNet::DataDesc->new(name => $k, shape => $shape, dtype => $v->dtype)
    } @{ $self->data }];
}

# The name and shape of label provided by this iterator
method provide_label()
{
    return [map {
        my ($k, $v) = @{ $_ };
        my $shape = $v->shape;
        $shape->[0] = $self->batch_size;
        AI::MXNet::DataDesc->new(name => $k, shape => $shape, dtype => $v->dtype)
    } @{ $self->label }];
}

# Ignore roll over data and set to start
method hard_reset()
{
    $self->cursor(-$self->batch_size);
}

method reset()
{
    if($self->last_batch_handle eq 'roll_over' and $self->cursor > $self->num_data)
    {
        $self->cursor(-$self->batch_size + ($self->cursor%$self->num_data)%$self->batch_size);
    }
    else
    {
        $self->cursor(-$self->batch_size);
    }
}

method iter_next()
{
    $self->cursor($self->batch_size + $self->cursor);
    return $self->cursor < $self->num_data;
}

method next()
{
    if($self->iter_next)
    {
        return AI::MXNet::DataBatch->new(
            data  => $self->getdata,
            label => $self->getlabel,
            pad   => $self->getpad,
            index => undef
        );
    }
    else
    {
        return undef;
    }
}

# Load data from underlying arrays, internal use only
method _getdata($data_source)
{
    confess("DataIter needs reset.") unless $self->cursor < $self->num_data;
    if(($self->cursor + $self->batch_size) <= $self->num_data)
    {
        return [
            map {
                $_->[1]->slice([$self->cursor,$self->cursor+$self->batch_size-1])
            } @{ $data_source }
        ];
    }
    else
    {
        my $pad = $self->batch_size - $self->num_data + $self->cursor - 1;
        return [
            map {
                AI::MXNet::NDArray->concatenate(
                    [
                        $_->[1]->slice([$self->cursor, -1]),
                        $_->[1]->slice([0, $pad])
                    ]
                )
            } @{ $data_source }
        ];
    }
}

method getdata()
{
    return $self->_getdata($self->data);
}

method getlabel()
{
    return $self->_getdata($self->label);
}

method getpad()
{
    if( $self->last_batch_handle eq 'pad'
            and
        ($self->cursor + $self->batch_size) > $self->num_data
    )
    {
        return $self->cursor + $self->batch_size - $self->num_data;
    }
    else
    {
        return 0;
    }
}

package AI::MXNet::MXDataIter;
use Mouse;
use AI::MXNet::Base;

extends 'AI::MXNet::DataIter';

=head1 NAME

    AI::MXNet::MXDataIter - A data iterator pre-built in C++ layer of MXNet.
=cut

has 'handle'           => (is => 'ro', isa => 'DataIterHandle', required => 1);
has '_debug_skip_load' => (is => 'rw', isa => 'Int', default => 0);
has '_debug_at_begin'  => (is => 'rw', isa => 'Int', default => 0);
has 'data_name'        => (is => 'ro', isa => 'Str', default => 'data');
has 'label_name'       => (is => 'ro', isa => 'Str', default => 'softmax_label');
has [qw/first_batch
        provide_data
        provide_label
        batch_size/]   => (is => 'rw', init_arg => undef);

sub BUILD
{
    my $self = shift;
    $self->first_batch($self->next);
    my $data = $self->first_batch->data->[0];
    $self->provide_data([
        AI::MXNet::DataDesc->new(
            name  => $self->data_name,
            shape => $data->shape,
            dtype => $data->dtype
        )
    ]);
    my $label = $self->first_batch->label->[0];
    $self->provide_label([
        AI::MXNet::DataDesc->new(
            name  => $self->label_name,
            shape => $label->shape,
            dtype => $label->dtype
        )
    ]);
    $self->batch_size($data->shape->[0]);
}

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

=head2 debug_skip_load

    Set the iterator to simply return always first batch.
    Notes
    -----
    This can be used to test the speed of network without taking
    the loading delay into account.
=cut

method debug_skip_load()
{
    $self->_debug_skip_load(1);
    AI::MXNet::Logging->info('Set debug_skip_load to be true, will simply return first batch');
}

method reset()
{
    $self->_debug_at_begin(1);
    $self->first_batch(undef);
    check_call(AI::MXNetCAPI::DataIterBeforeFirst($self->handle));
}

method next()
{
    if($self->_debug_skip_load and not $self->_debug_at_begin)
    {
        return  AI::MXNet::DataBatch->new(
                    data  => [$self->getdata],
                    label => [$self->getlabel],
                    pad   => $self->getpad,
                    index => $self->getindex
        );
    }
    if(defined $self->first_batch)
    {
        my $batch = $self->first_batch;
        $self->first_batch(undef);
        return $batch
    }
    $self->_debug_at_begin(0);
    my $next_res =  check_call(AI::MXNetCAPI::DataIterNext($self->handle));
    if($next_res)
    {
        return  AI::MXNet::DataBatch->new(
                    data  => [$self->getdata],
                    label => [$self->getlabel],
                    pad   => $self->getpad,
                    index => $self->getindex
        );
    }
    else
    {
        return undef;
    }
}

method iter_next()
{
    if(defined $self->first_batch)
    {
        return 1;
    }
    else
    {
        return scalar(check_call(AI::MXNetCAPI::DataIterNext($self->handle)));
    }
}

method getdata()
{
    my $handle = check_call(AI::MXNetCAPI::DataIterGetData($self->handle));
    return AI::MXNet::NDArray->new(handle => $handle);
}

method getlabel()
{
    my $handle = check_call(AI::MXNetCAPI::DataIterGetLabel($self->handle));
    return AI::MXNet::NDArray->new(handle => $handle);
}

method getindex()
{
    return pdl(check_call(AI::MXNetCAPI::DataIterGetIndex($self->handle)));
}

method getpad()
{
    return scalar(check_call(AI::MXNetCAPI::DataIterGetPadNum($self->handle)));
}

package AI::MXNet::IO;

sub NDArrayIter { shift; return AI::MXNet::NDArrayIter->new(@_); }

my %iter_meta;
method get_iter_meta()
{
    return \%iter_meta;
}

# Create an io iterator by handle.
func _make_io_iterator($handle)
{
    my ($iter_name, $desc,
        $arg_names, $arg_types, $arg_descs
    ) = @{ check_call(AI::MXNetCAPI::DataIterGetIterInfo($handle)) };
    my $param_str = build_param_doc($arg_names, $arg_types, $arg_descs);
    my $doc_str = "$desc\n\n"
                  ."$param_str\n"
                  ."name : string, required.\n"
                  ."    Name of the resulting data iterator.\n\n"
                  ."Returns\n"
                  ."-------\n"
                  ."iterator: DataIter\n"
                  ."    The result iterator.";
    my $iter = sub {
        my $class = shift;
        my (@args, %kwargs);
        if(@_ and ref $_[-1] eq 'HASH')
        {
            %kwargs = %{ pop(@_) };
        }
        @args = @_;
        Carp::confess("$iter_name can only accept keyword arguments")
            if @args;
        for my $key (keys %kwargs)
        {
            $kwargs{ $key } = "(" .join(",", @{ $kwargs{ $key } }) .")"
                if ref $kwargs{ $key } eq 'ARRAY';
        }
        my $handle = check_call(
            AI::MXNetCAPI::DataIterCreateIter(
                $handle,
                scalar(keys %kwargs),
                \%kwargs
            )
        );
        return AI::MXNet::MXDataIter->new(handle => $handle, %kwargs);
    };
    $iter_meta{$iter}{__name__} = $iter_name;
    $iter_meta{$iter}{__doc__}  = $doc_str;
    return $iter;
}

# List and add all the data iterators to current module.
method _init_io_module()
{
    for my $creator (@{ check_call(AI::MXNetCAPI::ListDataIters()) })
    {
        my $data_iter = _make_io_iterator($creator);
        {
            my $name = $iter_meta{ $data_iter }{__name__};
            no strict 'refs';
            {
                *{__PACKAGE__."::$name"} = $data_iter;
            } 
        }
    }
}

# Initialize the io in startups
__PACKAGE__->_init_io_module;

1;

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

package AI::MXNet::Image;
use strict;
use warnings;
use Scalar::Util qw(blessed);
use AI::MXNet::Base;
use AI::MXNet::Function::Parameters;

=head1 NAME

    AI::MXNet:Image - Read individual image files and perform augmentations.
=cut

=head2 imdecode

    Decode an image from string. Requires OpenCV to work.

    Parameters
    ----------
    $buf : str, array ref, pdl, ndarray
        Binary image data.
    :$flag : int
        0 for grayscale. 1 for colored.
    :$to_rgb : int
        0 for BGR format (OpenCV default). 1 for RGB format (MXNet default).
    :$out : NDArray
        Output buffer. Do not specify for automatic allocation.
=cut

method imdecode(Str|PDL $buf, Int :$flag=1, Int :$to_rgb=1, Maybe[AI::MXNet::NDArray] :$out=)
{
    if(not ref $buf)
    {
        my $pdl_type = PDL::Type->new(DTYPE_MX_TO_PDL->{'uint8'});
        my $len; { use bytes; $len = length $buf; }
        my $pdl = PDL->new_from_specification($pdl_type, $len);
        ${$pdl->get_dataref} = $buf;
        $pdl->upd_data;
        $buf = $pdl;
    }
    if(not (blessed $buf and $buf->isa('AI::MXNet::NDArray')))
    {
        $buf = AI::MXNet::NDArray->array($buf, dtype=>'uint8');
    }
    return AI::MXNet::NDArray->_cvimdecode($buf, { flag => $flag, to_rgb => $to_rgb, ($out ? (out => $out) : ()) });
}

=head2 scale_down

Scale down crop size if it's bigger than the image size.

    Parameters:
    -----------
    Shape $src_size
    Shape $size

    Returns:
    --------
    ($w, $h)
=cut

method scale_down(Shape $src_size, Shape $size)
{
    my ($w, $h) = @{ $size };
    my ($sw, $sh) = @{ $src_size };
    if($sh < $h)
    {
        ($w, $h) = (($w*$sh)/$h, $sh);
    }
    if($sw < $w)
    {
        ($w, $h) = ($sw, ($h*$sw)/$w);
    }
    return (int($w), int($h));
}

=head2 resize_short

    Resize shorter edge to the size.

    Parameters:
    -----------
    AI::MXNet::NDArray $src
    Int                $size
    Int                $interp=2

    Returns:
    --------
    AI::MXNet::NDArray $resized_image
=cut

method resize_short(AI::MXNet::NDArray $src, Int $size, Int $interp=2)
{
    my ($new_h, $new_w);
    my ($h, $w) = @{ $src->shape };
    if($h > $w)
    {
        ($new_h, $new_w) = ($size*$h/$w, $size);
    }
    else
    {
        ($new_h, $new_w) = ($size, $size*$w/$h);
    }
    return AI::MXNet::NDArray->_cvimresize($src, $new_w, $new_h, { interp=>$interp });
}

=head2 fixed_crop

    Crop src at fixed location, and (optionally) resize it to the size.

    Parameters:
    -----------
    AI::MXNet::NDArray $src
    Int                $x0
    Int                $y0
    Int                $w
    Int                $h
    Maybe[Shape]       $size=
    Int                $interp=2

    Returns:
    --------
    AI::MXNet::NDArray $cropped_image
=cut

method fixed_crop(AI::MXNet::NDArray $src, Int $x0, Int $y0, Int $w, Int $h, Maybe[Shape] $size=, Int $interp=2)
{
    my $out = AI::MXNet::NDArray->crop($src, { begin=>[$y0, $x0, 0], end=>[$y0+$h, $x0+$w, $src->shape->[2]] });
    if(defined $size and join(',', $w, $h) ne join(',', @{ $size }))
    {
        $out = AI::MXNet::NDArray->_cvimresize($out, @{ $size }, { interp=>$interp });
    }
    return $out;
}

=head2 random_crop

    Randomly crop src with size. Upsample result if src is smaller than the size.

    Parameters:
    -----------
    AI::MXNet::NDArray $src
    Shape              $size=
    Int                $interp=2

    Returns:
    --------
    ($cropped_image, [$x0, $y0, $new_w, $new_h])
=cut

method random_crop(AI::MXNet::NDArray $src, Shape $size, Int $interp=2)
{
    my ($h, $w) = @{ $src->shape };
    my ($new_w, $new_h) = __PACKAGE__->scale_down([$w, $h], $size);

    my $x0 = int(rand($w - $new_w + 1));
    my $y0 = int(rand($h - $new_h + 1));

    my $out = __PACKAGE__->fixed_crop($src, $x0, $y0, $new_w, $new_h, $size, $interp);
    return ($out, [$x0, $y0, $new_w, $new_h]);
}

=head2 center_crop

    Randomly crop src with size around the center. Upsample result if src is smaller than the size.

    Parameters:
    -----------
    AI::MXNet::NDArray $src
    Shape              $size=
    Int                $interp=2

    Returns:
    --------
    ($cropped_image, [$x0, $y0, $new_w, $new_h])
=cut

method center_crop(AI::MXNet::NDArray $src, Shape $size, Int $interp=2)
{
    my ($h, $w) = @{ $src->shape };
    my ($new_w, $new_h) = __PACKAGE__->scale_down([$w, $h], $size);

    my $x0 = int(($w - $new_w)/2);
    my $y0 = int(($h - $new_h)/2);

    my $out = __PACKAGE__->fixed_crop($src, $x0, $y0, $new_w, $new_h, $size, $interp);
    return ($out, [$x0, $y0, $new_w, $new_h]);
}

=head2 color_normalize

    Normalize src with mean and std.

    Parameters:
    -----------
    AI::MXNet::NDArray $src
    Num|AI::MXNet::NDArray $mean
    Maybe[Num|AI::MXNet::NDArray] $std=
    Int $interp=2

    Returns:
    --------
    AI::MXNet::NDArray $normalized_image
=cut

method color_normalize(AI::MXNet::NDArray $src, Num|AI::MXNet::NDArray $mean, Maybe[Num|AI::MXNet::NDArray] $std=)
{
    $src -= $mean;
    if(defined $std)
    {
        $src /= $std;
    }
    return $src;
}

=head2 random_size_crop

    Randomly crop src with size. Randomize area and aspect ratio.

    Parameters:
    -----------
    AI::MXNet::NDArray $src
    Shape              $size
    Num                $min_area
    ArrayRef[Int]      [$from, $to] # $ratio
    Maybe[Int]         $interp=2

    Returns:
    --------
    ($cropped_image, [$x0, $y0, $new_w, $new_h])
=cut

method random_size_crop(AI::MXNet::NDArray $src, Shape $size, Num $min_area, ArrayRef[Num] $ratio, Maybe[Int] $interp=2)
{
    my ($h, $w) = @{ $src->shape };
    my ($from, $to) = @{ $ratio };
    my $new_ratio = $from + ($to-$from) * rand;
    my $max_area;
    if($new_ratio * $h > $w)
    {
        $max_area = $w*int($w/$new_ratio);
    }
    else
    {
        $max_area = $h*int($h*$new_ratio);
    }

    $min_area *= $h*$w;
    if($max_area < $min_area)
    {
        return __PACKAGE__->random_crop($src, $size, $interp);
    }
    my $new_area = $min_area + ($max_area-$min_area) * rand;
    my $new_w = int(sqrt($new_area*$new_ratio));
    my $new_h = $new_w;

    assert($new_w <= $w and $new_h <= $h);
    my $x0 = int(rand($w - $new_w + 1));
    my $y0 = int(rand($h - $new_h + 1));

    my $out = __PACKAGE__->fixed_crop($src, $x0, $y0, $new_w, $new_h, $size, $interp);
    return ($out, [$x0, $y0, $new_w, $new_h]);
}

=head2 ResizeAug

    Makes "resize shorter edge to size augumenter" closure.

    Parameters:
    -----------
    Shape              $size
    Int                $interp=2

    Returns:
    --------
    CodeRef that accepts AI::MXNet::NDArray $src as input
    and returns [__PACKAGE__->resize_short($src, $size, $interp)]
=cut

method ResizeAug(Shape $size, Int $interp=2)
{
    my $aug = sub {
        my $src = shift;
        return [__PACKAGE__->resize_short($src, $size, $interp)];
    };
    return $aug;
}

=head2 RandomCropAug

    Makes "random crop augumenter" closure.

    Parameters:
    -----------
    Shape              $size
    Int                $interp=2

    Returns:
    --------
    CodeRef that accepts AI::MXNet::NDArray $src as input
    and returns [(__PACKAGE__->random_crop($src, $size, $interp))[0]]
=cut

method RandomCropAug(Shape $size, Int $interp=2)
{
    my $aug = sub {
        my $src = shift;
        return [(__PACKAGE__->random_crop($src, $size, $interp))[0]];
    };
    return $aug;
}

=head2 RandomSizedCropAug

    Makes "random crop augumenter" closure.

    Parameters:
    -----------
    Shape              $size
    Num                $min_area
    ArrayRef[Num]      $ratio
    Int                $interp=2

    Returns:
    CodeRef that accepts AI::MXNet::NDArray $src as input
    and returns [(__PACKAGE__->random_size_crop($src, $size, $min_area, $ratio, $interp))[0]]
=cut

method RandomSizedCropAug(Shape $size, Num $min_area, ArrayRef[Num] $ratio, Int $interp=2)
{
    my $aug = sub {
        my $src = shift;
        return [(__PACKAGE__->random_size_crop($src, $size, $min_area, $ratio, $interp))[0]];
    };
    return $aug;
}

=head2 CenterCropAug

    Makes "center crop augumenter" closure.

    Parameters:
    -----------
    Shape              $size
    Int                $interp=2

    Returns:
    CodeRef that accepts AI::MXNet::NDArray $src as input
    and returns [(__PACKAGE__->center_crop($src, $size, $interp))[0]]
=cut

method CenterCropAug(Shape $size, Int $interp=2)
{
    my $aug = sub {
        my $src = shift;
        return [(__PACKAGE__->center_crop($src, $size, $interp))[0]];
    };
    return $aug;
}

=head2 RandomOrderAug

    Makes "Apply list of augmenters in random order" closure.

    Parameters:
    -----------
    ArrayRef[CodeRef]  $ts

    Returns:
    --------
    CodeRef that accepts AI::MXNet::NDArray $src as input
    and returns ArrayRef[AI::MXNet::NDArray]
=cut

method RandomOrderAug(ArrayRef[CodeRef] $ts)
{
    my $aug = sub {
        my $src = shift;
        my @ts = List::Util::shuffle(@{ $ts });
        my @tmp;
        for my $t (@ts)
        {
            push @tmp, &{$t}($src);
        }
        return \@tmp;
    };
    return $aug;
}

=head2 RandomOrderAug

    Makes "Apply random brightness, contrast and saturation jitter in random order" closure

    Parameters:
    -----------
    Num $brightness
    Num $contrast
    Num $saturation

    Returns:
    --------
    CodeRef that accepts AI::MXNet::NDArray $src as input
    and returns ArrayRef[AI::MXNet::NDArray]
=cut

method ColorJitterAug(Num $brightness, Num $contrast, Num $saturation)
{
    my @ts;
    my $coef = AI::MXNet::NDArray->array([[[0.299, 0.587, 0.114]]]);
    if($brightness > 0)
    {
        my $baug = sub { my $src = shift;
            my $alpha = 1 + -$brightness + 2 * $brightness * rand;
            $src *= $alpha;
            return [$src];
        };
        push @ts, $baug;
    }

    if($contrast > 0)
    {
        my $caug = sub { my $src = shift;
            my $alpha = 1 + -$contrast + 2 * $contrast * rand;
            my $gray  = $src*$coef;
            $gray = (3.0*(1.0-$alpha)/$gray->size)*$gray->sum;
            $src *= $alpha;
            $src += $gray;
            return [$src];
        };
        push @ts, $caug;
    }

    if($saturation > 0)
    {
        my $saug = sub { my $src = shift;
            my $alpha = 1 + -$saturation + 2 * $saturation * rand;
            my $gray  = $src*$coef;
            $gray = AI::MXNet::NDArray->sum($gray, { axis=>2, keepdims =>1 });
            $gray *= (1.0-$alpha);
            $src *= $alpha;
            $src += $gray;
            return [$src];
        };
        push @ts, $saug;
    }

    return __PACKAGE__->RandomOrderAug(\@ts);
}

=head2 LightingAug

    Makes "Add PCA based noise" closure.

    Parameters:
    -----------
    Num $alphastd
    PDL $eigval
    PDL $eigvec

    Returns:
    --------
    CodeRef that accepts AI::MXNet::NDArray $src as input
    and returns ArrayRef[AI::MXNet::NDArray]
=cut

method LightingAug(Num $alphastd, PDL $eigval, PDL $eigvec)
{
    my $aug = sub { my $src = shift;
        my $alpha = AI::MXNet::NDArray->zeros([3]);
        AI::MXNet::Random->normal(0, $alphastd, { out => $alpha });
        my $rgb = ($eigvec*$alpha->aspdl) x $eigval;
        $src += AI::MXNet::NDArray->array($rgb);
        return [$src]
    };
    return $aug
}

=head2 ColorNormalizeAug

    Makes "Mean and std normalization" closure.

    Parameters:
    -----------
    PDL $mean
    PDL $std

    Returns:
    --------
    CodeRef that accepts AI::MXNet::NDArray $src as input
    and returns [__PACKAGE__->color_normalize($src, $mean, $std)]
=cut

method ColorNormalizeAug(PDL $mean, PDL $std)
{
    $mean = AI::MXNet::NDArray->array($mean);
    $std = AI::MXNet::NDArray->array($std);
    my $aug = sub { my $src = shift;
        return [__PACKAGE__->color_normalize($src, $mean, $std)]
    };
    return $aug;
}

=head2 HorizontalFlipAug

    Makes "Random horizontal flipping" closure.

    Parameters:
    -----------
    Num $p < 1

    Returns:
    --------
    CodeRef that accepts AI::MXNet::NDArray $src as input
    and returns [$p > rand ? AI::MXNet::NDArray->flip($src, axis=1>) : $src]
=cut

method HorizontalFlipAug(Num $p)
{
    my $aug = sub { my $src = shift;
        return [$p > rand() ? AI::MXNet::NDArray->flip($src, { axis=>1 }) : $src]
    };
    return $aug;
}

=head2 CastAug

    Makes "Cast to float32" closure.

    Returns:
    --------
    CodeRef that accepts AI::MXNet::NDArray $src as input
    and returns [$src->astype('float32')]
=cut

method CastAug()
{
    my $aug = sub { my $src = shift;
        return [$src->astype('float32')]
    };
    return $aug;
}

=head2 CreateAugmenter

    Create augumenter list

    Parameters:
    -----------
    Shape          :$data_shape,
    Bool           :$resize=0,
    Bool           :$rand_crop=0,
    Bool           :$rand_resize=0,
    Bool           :$rand_mirror=0,
    Maybe[Num|PDL] :$mean=,
    Maybe[Num|PDL] :$std=,
    Num            :$brightness=0,
    Num            :$contrast=0,
    Num            :$saturation=0,
    Num            :$pca_noise=0,
    Int            :$inter_method=2
=cut

method CreateAugmenter(
Shape          :$data_shape,
Bool           :$resize=0,
Bool           :$rand_crop=0,
Bool           :$rand_resize=0,
Bool           :$rand_mirror=0,
Maybe[Num|PDL] :$mean=,
Maybe[Num|PDL] :$std=,
Num            :$brightness=0,
Num            :$contrast=0,
Num            :$saturation=0,
Num            :$pca_noise=0,
Int            :$inter_method=2
)
{
    my @auglist;
    if($resize > 0)
    {
        push @auglist, __PACKAGE__->ResizeAug($resize, $inter_method);
    }

    my $crop_size = [$data_shape->[2], $data_shape->[1]];
    if($rand_resize)
    {
        assert($rand_crop);
        push @auglist, __PACKAGE__->RandomSizedCropAug($crop_size, 0.3, [3.0/4.0, 4.0/3.0], $inter_method);
    }
    elsif($rand_crop)
    {
        push @auglist, __PACKAGE__->RandomCropAug($crop_size, $inter_method);
    }
    else
    {
        push @auglist, __PACKAGE__->CenterCropAug($crop_size, $inter_method);
    }

    if($rand_mirror)
    {
        push @auglist, __PACKAGE__->HorizontalFlipAug(0.5);
    }

    push @auglist, __PACKAGE__->CastAug;

    if($brightness or $contrast or $saturation)
    {
        push @auglist, __PACKAGE__->ColorJitterAug($brightness, $contrast, $saturation);
    }
    if($pca_noise > 0)
    {
        my $eigval = AI::MXNet::NDArray->array([55.46, 4.794, 1.148])->aspdl;
        my $eigvec = AI::MXNet::NDArray->array([[-0.5675, 0.7192, 0.4009],
                           [-0.5808, -0.0045, -0.8140],
                           [-0.5836, -0.6948, 0.4203]])->aspdl;
        push @auglist, __PACKAGE__->LightingAug($pca_noise, $eigval, $eigvec);
    }

    if($mean)
    {
        $mean = AI::MXNet::NDArray->array([123.68, 116.28, 103.53])->aspdl;
    }
    if($std)
    {
        $std = AI::MXNet::NDArray->array([58.395, 57.12, 57.375])->aspdl;
    }
    if(defined $mean)
    {
        assert(defined $std);
        push @auglist, __PACKAGE__->ColorNormalizeAug($mean, $std);
    }

    return \@auglist;
}

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

package AI::MXNet::ImageIter;
use Mouse;
use AI::MXNet::Base;
extends 'AI::MXNet::DataIter';

=head1 NAME

    AI::MXNet::ImageIter - Image data iterator.
=cut

=head1 DESCRIPTION


    Image data iterator with a large number of augumentation choices.
    Supports reading from both .rec files and raw image files with image list.

    To load from .rec files, please specify path_imgrec. Also specify path_imgidx
    to use data partition (for distributed training) or shuffling.

    To load from raw image files, specify path_imglist and path_root.

    Parameters
    ----------
    batch_size : Int
        Number of examples per batch
    data_shape : Shape
        Data shape in (channels, height, width).
        For now, only RGB image with 3 channels is supported.
    label_width : Int
        dimension of label
    path_imgrec : str
        path to image record file (.rec).
        Created with tools/im2rec.py or bin/im2rec
    path_imglist : str
        path to image list (.lst)
        Created with tools/im2rec.py or with custom script.
        Format: index\t[one or more label separated by \t]\trelative_path_from_root
    imglist: array ref
        a list of image with the label(s)
        each item is a list [imagelabel: float or array ref of float, imgpath]
    path_root : str
        Root folder of image files
    path_imgidx : str
        Path to image index file. Needed for partition and shuffling when using .rec source.
    shuffle : bool
        Whether to shuffle all images at the start of each iteration.
    Can be slow for HDD.
    part_index : int
        Partition index
    num_parts : int
        Total number of partitions.
    data_name='data' Str
    label_name='softmax_label' Str
    kwargs : hash ref with any additional arguments for augmenters
=cut

has 'batch_size'  => (is => 'ro', isa => 'Int',   required => 1);
has 'data_shape'  => (is => 'ro', isa => 'Shape', required => 1);
has 'label_width' => (is => 'ro', isa => 'Int',   default  => 1);
has 'data_name'   => (is => 'ro', isa => 'Str',   default  => 'data');
has 'label_name'  => (is => 'ro', isa => 'Str',   default  => 'softmax_label');
has [qw/path_imgrec
        path_imglist
        path_root
        path_imgidx
    /]            => (is => 'ro', isa => 'Str');
has 'shuffle'     => (is => 'ro', isa => 'Bool', default => 0);
has 'part_index'  => (is => 'ro', isa => 'Int', default => 0);
has 'num_parts'   => (is => 'ro', isa => 'Int', default => 0);
has 'aug_list'    => (is => 'rw', isa => 'ArrayRef[CodeRef]');
has 'imglist'     => (is => 'rw', isa => 'ArrayRef|HashRef');
has 'kwargs'      => (is => 'ro', isa => 'HashRef');
has [qw/imgidx
        imgrec
        seq
        cur
        provide_data
        provide_label
           /]     => (is => 'rw', init_arg => undef);

sub BUILD
{
    my $self = shift;
    assert($self->path_imgrec or $self->path_imglist or ref $self->imglist eq 'ARRAY');
    if($self->path_imgrec)
    {
        print("loading recordio...\n");
        if($self->path_imgidx)
        {
            $self->imgrec(
                AI::MXNet::IndexedRecordIO->new(
                    idx_path => $self->path_imgidx,
                    uri => $self->path_imgrec,
                    flag => 'r'
                )
            );
            $self->imgidx([@{ $self->imgrec->keys }]);
        }
        else
        {
            $self->imgrec(AI::MXNet::RecordIO->new(uri => $self->path_imgrec, flag => 'r'));
        }
    }
    my %imglist;
    my @imgkeys;
    if($self->path_imglist)
    {
        print("loading image list...\n");
        open(my $f, $self->path_imglist) or confess("can't open ${\ $self->path_imglist } : $!");
        while(my $line = <$f>)
        {
            chomp($line);
            my @line = split(/\t/, $line);
            my $label = AI::MXNet::NDArray->array([@line[1..@line-2]]);
            my $key   = $line[0];
            $imglist{$key} = [$label, $line[-1]];
            push @imgkeys, $key;
        }
        $self->imglist(\%imglist);
    }
    elsif(ref $self->imglist eq 'ARRAY')
    {
        print("loading image list...\n");
        my %result;
        my $index = 1;
        for my $img (@{ $self->imglist })
        {
            my $key = $index++;
            my $label;
            if(not ref $img->[0])
            {
                $label = AI::MXNet::NDArray->array([$img->[0]]);
            }
            else
            {
                $label = AI::MXNet::NDArray->array($img->[0]);
                $result{$key} = [$label, $img->[1]];
                push @imgkeys, $key;
            }
        }
        $self->imglist(\%result);
    }
    assert(@{ $self->data_shape } == 3 and $self->data_shape->[0] == 3);
    $self->provide_data([
        AI::MXNet::DataDesc->new(
            name  => $self->data_name,
            shape => [$self->batch_size, @{ $self->data_shape }]
        )
    ]);
    if($self->label_width > 1)
    {
        $self->provide_label([
            AI::MXNet::DataDesc->new(
                name  => $self->label_name,
                shape => [$self->batch_size, $self->label_width]
            )
        ]);
    }
    else
    {
        $self->provide_label([
            AI::MXNet::DataDesc->new(
                name  => $self->label_name,
                shape => [$self->batch_size]
            )
        ]);
    }
    if(not defined $self->imgrec)
    {
        $self->seq(\@imgkeys);
    }
    elsif($self->shuffle or $self->num_parts > 1)
    {
        assert(defined $self->imgidx);
        $self->seq($self->imgidx);
    }
    if($self->num_parts > 1)
    {
        assert($self->part_index < $self->num_parts);
        my $N = @{ $self->seq };
        my $C = $N/$self->num_parts;
        $self->seq([@{ $self->seq }[$self->part_index*$C..($self->part_index+1)*$C-1]]);
    }
    if(defined $self->aug_list or defined $self->kwargs)
    {
        $self->aug_list(AI::MXNet::Image->CreateAugmenter(data_shape => $self->data_shape, %{ $self->kwargs//{} }));
    }
    else
    {
        $self->aug_list([]);
    }
    $self->cur(0);
    $self->reset();
}

method reset()
{
    if($self->shuffle)
    {
        @{ $self->seq } = List::Util::shuffle(@{ $self->seq });
    }
    if(defined $self->imgrec)
    {
        $self->imgrec->reset;
    }
    $self->cur(0);
}

method next_sample()
{
    if(defined $self->seq)
    {
        return undef if($self->cur >= @{ $self->seq });
        my $idx = $self->seq->[$self->cur];
        $self->cur($self->cur + 1);
        if(defined $self->imgrec)
        {
            my $s = $self->imgrec->read_idx($idx);
            my ($header, $img) = AI::MXNet::RecordIO->unpack($s);
            if(not defined $self->imglist)
            {
                return ($header->label, $img);
            }
            else
            {
                return ($self->imglist->{$idx}[0], $img);
            }
        }
        else
        {
            my ($label, $fname) = @{ $self->imglist->{$idx} };
            if(not defined $self->imgrec)
            {
                open(F, $self->path_root . "/$fname") or confess("can't open $fname $!");
                my $img;
                { local $/ = undef; $img = <F> };
                close(F);
                return ($label, $img);
            }
        }
    }
    else
    {
        my $s = $self->imgrec->read;
        return undef if(not defined $s);
        my ($header, $img) = AI::MXNet::RecordIO->unpack($s);
        return ($header->label, $img)
    }
}

method next()
{
    my $batch_size = $self->batch_size;
    my ($c, $h, $w) = @{ $self->data_shape };
    my $batch_data  = AI::MXNet::NDArray->empty([$batch_size, $c, $h, $w]);
    my $batch_label = AI::MXNet::NDArray->empty(@{$self->provide_label->[0]}[1]);
    my $i = 0;
    while ($i < $batch_size)
    {
        my ($label, $s) = $self->next_sample;
        last if not defined $label;
        my $data = [AI::MXNet::Image->imdecode($s)];
        if(@{ $data->[0]->shape } == 0)
        {
            AI::MXNet::Logging->debug('Invalid image, skipping.');
            next;
        }
        for my $aug (@{ $self->aug_list })
        {
            $data = [map { @{ $aug->($_) } } @$data];
        }
        for my $d (@$data)
        {
            assert(($i < $batch_size), 'Batch size must be multiples of augmenter output length');
            $batch_data->at($i)  .= AI::MXNet::NDArray->transpose($d, { axes=>[2, 0, 1] });
            $batch_label->at($i) .= $label;
            $i++;
        }
    }
    return undef if not $i;
    return AI::MXNet::DataBatch->new(data=>[$batch_data], label=>[$batch_label], pad => $batch_size-$i);
}

1;

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

package AI::MXNet::InitDesc;
use Mouse;
use AI::MXNet::Function::Parameters;

=head1 NAME

    AI::MXNet::InitDesc - A container for the initialization pattern serialization.

=head2 new

    Parameters
    ---------
    name : str
        name of variable
    attrs : hash ref of str to str
        attributes of this variable taken from AI::MXNet::Symbol->attr_dict
=cut
has 'name'        => (is => 'ro', isa => 'Str', required => 1);
has 'attrs'       => (is => 'rw', isa => 'HashRef[Str]', lazy => 1, default => sub { +{} });
use overload '""' => sub { shift->name };
around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    return $class->$orig(name => $_[0]) if @_ == 1;
    return $class->$orig(@_);
};

# Base class for Initializers
package AI::MXNet::Initializer;
use Mouse;
use AI::MXNet::Base qw(:DEFAULT pzeros pceil);
use AI::MXNet::NDArray;
use JSON::PP;
use overload "&{}" => sub { my $self = shift; sub { $self->call(@_) } },
             '""'  => sub {
                my $self = shift;
                my ($name) = ref($self) =~ /::(\w+)$/;
                encode_json(
                    [lc $name,
                        $self->kwargs//{ map { $_ => "".$self->$_ } $self->meta->get_attribute_list }
                ]);
             },
             fallback => 1;
has 'kwargs' => (is => 'rw', init_arg => undef, isa => 'HashRef');
has '_verbose'    => (is => 'rw', isa => 'Bool', lazy => 1, default => 0);
has '_print_func' => (is => 'rw', isa => 'CodeRef', lazy => 1,
    default => sub {
        return sub {
            my $x = shift;
            return ($x->norm/sqrt($x->size))->asscalar;
        };
    }
);

=head1 NAME

    AI::MXNet::Initializer - Base class for all Initializers

=head2 register

    Register an initializer class to the AI::MXNet::Initializer factory.
=cut

=head2 set_verbosity

    Switch on/off verbose mode

    Parameters
    ----------
    $verbose : bool
        switch on/off verbose mode
    $print_func : CodeRef
        A function that computes statistics of initialized arrays.
        Takes an AI::MXNet::NDArray and returns a scalar. Defaults to mean
        absolute value |x|/size(x)
=cut

method set_verbosity(Bool $verbose=0, CodeRef $print_func=)
{
    $self->_verbose($verbose);
    $self->_print_func($print_func) if defined $print_func;
}

method _verbose_print($desc, $init, $arr)
{
    if($self->_verbose and defined $self->_print_func)
    {
        AI::MXNet::Logging->info('Initialized %s as %s: %s', $desc, $init, $self->_print_func->($arr));
    }
}

my %init_registry;
method get_init_registry()
{
    return \%init_registry;
}

method register()
{
    my ($name) = $self =~ /::(\w+)$/;
    my $orig_name = $name;
    $name         = lc $name;
    if(exists $init_registry{ $name })
    {
        my $existing = $init_registry{ $name };
        warn(
            "WARNING: New initializer $self.$name" 
            ."is overriding existing initializer $existing.$name"
        );
    }
    $init_registry{ $name } = $self;
    {
        no strict 'refs';
        no warnings 'redefine';
        *{"$orig_name"} = sub { shift; $self->new(@_) };
        *InitDesc       = sub { shift; AI::MXNet::InitDesc->new(@_) };
    }
}

=head2 init

    Parameters
    ----------
    $desc : AI::MXNet::InitDesc|str
        a name of corresponding ndarray
        or the object that describes the initializer.

    $arr : AI::MXNet::NDArray
        an ndarray to be initialized.
=cut
method call(Str|AI::MXNet::InitDesc $desc, AI::MXNet::NDArray $arr)
{
    return $self->_legacy_init($desc, $arr) unless blessed $desc;
    my $init = $desc->attrs->{ __init__ };
    if($init)
    {
      my ($klass, $kwargs) = @{ decode_json($init) };
      $self->get_init_registry->{ lc $klass }->new(%{ $kwargs })->_init_weight("$desc", $arr);
      $self->_verbose_print($desc, $init, $arr);
    }
    else
    {
        $desc = "$desc";
        if($desc =~ /(weight|bias|gamma|beta)$/)
        {
            my $method = "_init_$1";
            $self->$method($desc, $arr);
            $self->_verbose_print($desc, $1, $arr);
        }
        else
        {
            $self->_init_default($desc, $arr)
        }
    }
}


method _legacy_init(Str $name, AI::MXNet::NDArray $arr)
{
    warnings::warnif(
        'deprecated',
        'Calling initializer with init($str, $NDArray) has been deprecated.'.
        'please use init(mx->init->InitDesc(...), NDArray) instead.'
    );
    if($name =~ /^upsampling/)
    {
        $self->_init_bilinear($name, $arr);
    }
    elsif($name =~ /^stn_loc/ and $name =~ /weight$/)
    {
        $self->_init_zero($name, $arr);
    }
    elsif($name =~ /^stn_loc/ and $name =~ /bias$/)
    {
        $self->_init_loc_bias($name, $arr);
    }
    elsif($name =~ /bias$/)
    {
        $self->_init_bias($name, $arr);
    }
    elsif($name =~ /gamma$/)
    {
        $self->_init_gamma($name, $arr);
    }
    elsif($name =~ /beta$/)
    {
        $self->_init_beta($name, $arr);
    }
    elsif($name =~ /weight$/)
    {
        $self->_init_weight($name, $arr);
    }
    elsif($name =~ /moving_mean$/)
    {
        $self->_init_zero($name, $arr);
    }
    elsif($name =~ /moving_var$/)
    {
        $self->_init_one($name, $arr);
    }
    elsif($name =~ /moving_inv_var$/)
    {
        $self->_init_zero($name, $arr);
    }
    elsif($name =~ /moving_avg$/)
    {
        $self->_init_zero($name, $arr);
    }
    else
    {
        $self->_init_default($name, $arr);
    }
}

*slice = *call;

method _init_bilinear($name, $arr)
{
    my $pdl_type = PDL::Type->new(DTYPE_MX_TO_PDL->{ 'float32' });
    my $weight = pzeros(
        PDL::Type->new(DTYPE_MX_TO_PDL->{ 'float32' }),
        $arr->size
    );
    my $shape = $arr->shape;
    my $size = $arr->size;
    my $f = pceil($shape->[3] / 2)->at(0);
    my $c = (2 * $f - 1 - $f % 2) / (2 * $f);
    for my $i (0..($size-1))
    {
        my $x = $i % $shape->[3];
        my $y = ($i / $shape->[3]) % $shape->[2];
        $weight->index($i) .= (1 - abs($x / $f - $c)) * (1 - abs($y / $f - $c));
    }
    $arr .= $weight->reshape(reverse @{ $shape });
}

method _init_loc_bias($name, $arr)
{
    confess("assert error shape[0] == 6")
        unless $arr->shape->[0] == 6;
    $arr .= [1.0, 0, 0, 0, 1.0, 0];
}

method _init_zero($name, $arr)
{
    $arr .= 0;
}

method _init_one($name, $arr)
{
    $arr .= 1;
}

method _init_bias($name, $arr)
{
    $arr .= 0;
}

method _init_gamma($name, $arr)
{
    $arr .= 1;
}

method _init_beta($name, $arr)
{
    $arr .= 0;
}

method _init_weight($name, $arr)
{
    confess("Virtual method, subclass must override it");
}

method _init_default($name, $arr)
{
    confess(
        "Unknown initialization pattern for $name. "
        .'Default initialization is now limited to '
        .'"weight", "bias", "gamma" (1.0), and "beta" (0.0).'
        .'Please use mx.sym.Variable(init=mx.init.*) to set initialization pattern'
    );
}

=head1 NAME

    AI::MXNet::Load  - Initialize by loading a pretrained param from a hash ref.
=cut

=head2 new

    Parameters
    ----------
    param: HashRef[AI::MXNet::NDArray]
    default_init: Initializer
        default initializer when a name is not found in the param hash ref.
    verbose: bool
    log the names when initializing.
=cut

package AI::MXNet::Load;
use Mouse;
extends 'AI::MXNet::Initializer';

has 'param'        => (is => "rw", isa => 'HashRef[AI::MXNet::NDArray]', required => 1);
has 'default_init' => (is => "rw", isa => "AI::MXNet::Initializer");
has 'verbose'      => (is => "rw", isa => "Int", default => 0);

sub BUILD
{
    my $self = shift;
    my $param = AI::MXNet::NDArray->load($self->param) unless ref $self->param;
    my %self_param;
    while(my ($name, $arr) = each %{ $self->param })
    {
        $name =~ s/^(?:arg|aux)://;
        $self_param{ $name } = $arr;
    }
    $self->param(\%self_param);
}

method call(Str $name, AI::MXNet::NDArray $arr)
{
    if(exists $self->param->{ $name })
    {
        my $target_shape = join(',', @{ $arr->shape });
        my $param_shape  = join(',', @{ $self->param->{ $name }->shape });
        confess(
            "Parameter $name cannot be initialized from loading. "
            ."Shape mismatch, target $target_shape vs loaded $param_shape"
        ) unless $target_shape eq $param_shape;
        $arr .= $self->param->{ $name };
        AI::MXNet::Log->info("Initialized $name by loading") if $self->verbose;
    }
    else
    {
        confess(
            "Cannot Initialize $name. Not found in loaded param "
            ."and no default Initializer is provided."
        ) unless defined $self->default_init;
        $self->default_init($name, $arr);
        AI::MXNet::Log->info("Initialized $name by default") if $self->verbose;
    }
}

*slice = *call;

=head1 NAME

    AI::MXNet::Mixed - A container for multiple initializer patterns.
=cut

=head2 new

    patterns: array ref of str
        array ref of regular expression patterns to match parameter names.
    initializers: array ref of AI::MXNet::Initializer objects.
        array ref of Initializers corresponding to the patterns.
=cut

package AI::MXNet::Mixed;
use Mouse;
extends 'AI::MXNet::Initializer';

has "map"          => (is => "rw", init_arg => undef);
has "patterns"     => (is => "ro", isa => 'ArrayRef[Str]');
has "initializers" => (is => "ro", isa => 'ArrayRef[AI::MXnet::Initializer]');

sub BUILD
{
    my $self = shift;
    confess("patterns count != initializers count")
        unless (@{ $self->patterns } == @{ $self->initializers });
    my %map;
    @map{ @{ $self->patterns } } = @{ $self->initializers };
    $self->map(\%map);
}

method call(Str $name, AI::MXNet::NDArray $arr)
{
    for my $pattern (keys %{ $self->map })
    {
        if($name =~ /$pattern/)
        {
            &{$self->map->{$pattern}}($name, $arr);
            return;
        }
    }
    confess(
        "Parameter name $name did not match any pattern. Consider"
        ."add a \".*\" pattern at the and with default Initializer."
    );
}

package AI::MXNet::Zero;
use Mouse;
extends 'AI::MXNet::Initializer';
method _init_weight(Str $name, AI::MXNet::NDArray $arr)
{
    $arr .= 0;
}

__PACKAGE__->register;

package AI::MXNet::One;
use Mouse;
extends 'AI::MXNet::Initializer';
method _init_weight(Str $name, AI::MXNet::NDArray $arr)
{
    $arr .= 1;
}

__PACKAGE__->register;

package AI::MXNet::Constant;
use Mouse;
extends 'AI::MXNet::Initializer';
has 'value' => (is => 'ro', isa => 'Num', required => 1);
around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    return $class->$orig(value => $_[0]) if @_ == 1;
    return $class->$orig(@_);
};

method _init_weight(Str $name, AI::MXNet::NDArray $arr)
{
    $arr .= $self->value;
}

__PACKAGE__->register;

=head1 NAME

    AI::MXNet::Uniform - Initialize the weight with uniform random values.
=cut

=head1 DESCRIPTION

    Initialize the weight with uniform random values contained within of [-scale, scale]

    Parameters
    ----------
    scale : float, optional
        The scale of the uniform distribution.
=cut

package AI::MXNet::Uniform;
use Mouse;
extends 'AI::MXNet::Initializer';
has "scale" => (is => "ro", isa => "Num", default => 0.7);
around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    return $class->$orig(scale => $_[0]) if @_ == 1;
    return $class->$orig(@_);
};

method _init_weight(Str $name, AI::MXNet::NDArray $arr)
{
    AI::MXNet::Random->uniform(-$self->scale, $self->scale, { out => $arr });
}

__PACKAGE__->register;

=head1 NAME

    AI::MXNet::Normal - Initialize the weight with gaussian random values.
=cut

=head1 DESCRIPTION

    Initialize the weight with gaussian random values contained within of [0, sigma]

    Parameters
    ----------
    sigma : float, optional
        Standard deviation for the gaussian distribution.
=cut

package AI::MXNet::Normal;
use Mouse;
extends 'AI::MXNet::Initializer';
has "sigma" => (is => "ro", isa => "Num", default => 0.01);
around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    return $class->$orig(sigma => $_[0]) if @_ == 1;
    return $class->$orig(@_);
};

method _init_weight(Str $name, AI::MXNet::NDArray $arr)
{
    AI::MXNet::Random->normal(0, $self->sigma, { out => $arr });
}

__PACKAGE__->register;

=head1 NAME

    AI::MXNet::Orthogonal - Intialize the weight as an Orthogonal matrix.
=cut

=head1 DESCRIPTION

    Intialize weight as Orthogonal matrix

    Parameters
    ----------
    scale : float, optional
        scaling factor of weight

    rand_type: string optional
        use "uniform" or "normal" random number to initialize weight

    Reference
    ---------
    Exact solutions to the nonlinear dynamics of learning in deep linear neural networks
    arXiv preprint arXiv:1312.6120 (2013).
=cut

package AI::MXNet::Orthogonal;
use AI::MXNet::Base;
use Mouse;
use AI::MXNet::Types;
extends 'AI::MXNet::Initializer';
has "scale" => (is => "ro", isa => "Num", default => 1.414);
has "rand_type" => (is => "ro", isa => enum([qw/uniform normal/]), default => 'uniform');

method _init_weight(Str $name, AI::MXNet::NDArray $arr)
{
    my @shape = @{ $arr->shape };
    my $nout = $shape[0];
    my $nin = AI::MXNet::NDArray->size([@shape[1..$#shape]]);
    my $tmp = AI::MXNet::NDArray->zeros([$nout, $nin]);
    if($self->rand_type eq 'uniform')
    {
        AI::MXNet::Random->uniform(-1, 1, { out => $tmp });
    }
    else
    {
        AI::MXNet::Random->normal(0, 1, { out => $tmp });
    }
    $tmp = $tmp->aspdl;
    my ($u, $s, $v) = svd($tmp);
    my $q;
    if(join(',', @{ $u->shape->unpdl }) eq join(',', @{ $tmp->shape->unpdl }))
    {
        $q = $u;
    }
    else
    {
        $q = $v;
    }
    $q = $self->scale * $q->reshape(reverse(@shape));
    $arr .= $q;
}

*slice = *call;
__PACKAGE__->register;

=head1 NAME

    AI::MXNet::Xavier - Initialize the weight with Xavier or similar initialization scheme.
=cut

=head1 DESCRIPTION

    Parameters
    ----------
    rnd_type: str, optional
        Use gaussian or uniform.
    factor_type: str, optional
        Use avg, in, or out.
    magnitude: float, optional
        The scale of the random number range.
=cut

package AI::MXNet::Xavier;
use Mouse;
use AI::MXNet::Types;
extends 'AI::MXNet::Initializer';
has "magnitude"   => (is => "rw", isa => "Num", default => 3);
has "rnd_type"    => (is => "ro", isa => enum([qw/uniform gaussian/]), default => 'uniform');
has "factor_type" => (is => "ro", isa => enum([qw/avg in out/]), default => 'avg');

method _init_weight(Str $name, AI::MXNet::NDArray $arr)
{
    my @shape = @{ $arr->shape };
    my $hw_scale = 1;
    if(@shape > 2)
    {
        $hw_scale = AI::MXNet::NDArray->size([@shape[2..$#shape]]);
    }
    my ($fan_in, $fan_out) = ($shape[1] * $hw_scale, $shape[0] * $hw_scale);
    my $factor;
    if($self->factor_type eq "avg")
    {
        $factor = ($fan_in + $fan_out) / 2;
    }
    elsif($self->factor_type eq "in")
    {
        $factor = $fan_in;
    }
    else
    {
        $factor = $fan_out;
    }
    my $scale = sqrt($self->magnitude / $factor);
    if($self->rnd_type eq "iniform")
    {
        AI::MXNet::Random->uniform(-$scale, $scale, { out => $arr });
    }
    else
    {
        AI::MXNet::Random->normal(0, $scale, { out => $arr });
    }
}
__PACKAGE__->register;

=head1 NAME

    AI::MXNet::MSRAPrelu - Custom initialization scheme.
=cut

=head1 DESCRIPTION

    Initialize the weight with initialization scheme from
    Delving Deep into Rectifiers: Surpassing Human-Level Performance on ImageNet Classification.

    Parameters
    ----------
    factor_type: str, optional
        Use avg, in, or out.
    slope: float, optional
        initial slope of any PReLU (or similar) nonlinearities.
=cut

package AI::MXNet::MSRAPrelu;
use Mouse;
extends 'AI::MXNet::Xavier';

has '+rnd_type'    => (default => "gaussian");
has '+factor_type' => (default => "avg");
has 'slope'        => (is => 'ro', isa => 'Num', default => 0.25);

sub BUILD
{
    my $self = shift;
    my $magnitude = 2 / (1 + $self->slope ** 2);
    $self->magnitude($magnitude);
    $self->kwargs({ slope => $self->slope, factor_type => $self->factor_type });
}
__PACKAGE__->register;

package AI::MXNet::Bilinear;
use Mouse;
use AI::MXNet::Base;
extends 'AI::MXNet::Initializer';

method _init_weight($name, $arr)
{
    my $pdl_type = PDL::Type->new(DTYPE_MX_TO_PDL->{ 'float32' });
    my $weight = pzeros(
        PDL::Type->new(DTYPE_MX_TO_PDL->{ 'float32' }),
        $arr->size
    );
    my $shape = $arr->shape;
    my $size = $arr->size;
    my $f = pceil($shape->[3] / 2)->at(0);
    my $c = (2 * $f - 1 - $f % 2) / (2 * $f);
    for my $i (0..($size-1))
    {
        my $x = $i % $shape->[3];
        my $y = ($i / $shape->[3]) % $shape->[2];
        $weight->index($i) .= (1 - abs($x / $f - $c)) * (1 - abs($y / $f - $c));
    }
    $arr .= $weight->reshape(reverse @{ $shape });
}

__PACKAGE__->register;

package AI::MXNet::LSTMBias;

=head1 NAME

    AI::MXNet::LSTMBias - Custom initializer for LSTM cells.
=cut

=head1 DESCRIPTION

    Initializes all biases of an LSTMCell to 0.0 except for
    the forget gate's bias that is set to a custom value.

    Parameters
    ----------
    forget_bias: float,a bias for the forget gate.
    Jozefowicz et al. 2015 recommends setting this to 1.0.
=cut

use Mouse;
extends 'AI::MXNet::Initializer';
has 'forget_bias' => (is => 'ro', isa => 'Num', required => 1);

method _init_weight(Str $name, AI::MXNet::NDArray $arr)
{
    $arr .= 0;
    # in the case of LSTMCell the forget gate is the second
    # gate of the 4 LSTM gates, we modify the according values.
    my $num_hidden = int($arr->shape->[0] / 4);
    $arr->slice([$num_hidden, 2*$num_hidden-1]) .= $self->forget_bias;
}

__PACKAGE__->register;

package AI::MXNet::FusedRNN;
use Mouse;
use JSON::PP;
extends 'AI::MXNet::Initializer';

=head1 NAME

    AI::MXNet::FusedRNN - Custom initializer for fused RNN cells.
=cut

=head1 DESCRIPTION

    Initializes parameters for fused rnn layer.

    Parameters
    ----------
    init : Initializer
        initializer applied to unpacked weights.
    All parameters below must be exactly the same as ones passed to the
    FusedRNNCell constructor.

    num_hidden : int
    num_layers : int
    mode : str
    bidirectional : bool
    forget_bias : float
=cut

has 'init'          => (is => 'rw', isa => 'Str|AI::MXNet::Initializer', required => 1);
has 'forget_bias'   => (is => 'ro', isa => 'Num', default => 1);
has [qw/num_hidden
       num_layers/] => (is => 'ro', isa => 'Int', required => 1);
has 'mode'          => (is => 'ro', isa => 'Str', required => 1);
has 'bidirectional' => (is => 'ro', isa => 'Bool', default => 0);

sub BUILD
{
    my $self = shift;
    if(not blessed $self->init)
    {
        my ($klass, $kwargs);
        eval {
            ($klass, $kwargs) = @{ decode_json($self->init) };
        };
        confess("FusedRNN failed to init $@") if $@;
        $self->init($self->get_init_registry->{ lc $klass }->new(%$kwargs));
    }
}

method _init_weight($name, $arr)
{
    my $cell = AI::MXNet::RNN::FusedCell->new(
        num_hidden    => $self->num_hidden,
        num_layers    => $self->num_layers,
        mode          => $self->mode,
        bidirectional => $self->bidirectional,
        forget_bias   => $self->forget_bias,
        prefix        => ''
    );

    my $args = $cell->unpack_weights({ parameters => $arr });
    for my $name (keys %{ $args })
    {
        my $desc = AI::MXNet::InitDesc->new(name => $name);
        # for lstm bias, we use a custom initializer
        # which adds a bias to the forget gate
        if($self->mode eq 'lstm' and $name =~ /f_bias$/)
        {
            $args->{$name} .= $self->forget_bias;
        }
        else
        {
            &{$self->init}($desc, $args->{$name});
        }
    }

    $arr .= $cell->pack_weights($args)->{parameters};
}

__PACKAGE__->register;

1;

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

package AI::MXNet::KVStore;
use strict;
use warnings;
use AI::MXNet::Base;
use AI::MXNet::NDArray;
use AI::MXNet::Optimizer;
use MIME::Base64;
use Storable;
use Mouse;
use AI::MXNet::Function::Parameters;

=head1 NAME

    AI::MXNet::KVStore - Key value store interface of MXNet.

=head1 DESCRIPTION 

    Key value store interface of MXNet for parameter synchronization, over multiple devices.
=cut

has 'handle' => (is => 'ro', isa => 'KVStoreHandle', required => 1);
has '_updater' => (is => 'rw',  isa => 'AI::MXNet::Updater');
has '_updater_func' => (is => 'rw', isa => 'CodeRef');

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

=head2  init

    Initialize a single or a sequence of key-value pairs into the store.
    For each key, one must init it before push and pull.
    Only worker 0's (rank == 0) data are used.
    This function returns after data have been initialized successfully

    Parameters
    ----------
    key : str or an array ref of str
        The keys.
    value : NDArray or an array ref of NDArray objects
        The values.

    Examples
    --------
    >>> # init a single key-value pair
    >>> $shape = [2,3]
    >>> $kv = mx->kv->create('local')
    >>> $kv->init(3, mx->nd->ones($shape)*2)
    >>> $a = mx->nd->zeros($shape)
    >>> $kv->pull(3, out=>$a)
    >>> print $a->aspdl
    [[ 2  2  2]
    [ 2  2  2]]

    >>> # init a list of key-value pairs
    >>> $keys = [5, 7, 9]
    >>> $kv->init(keys, [map { mx->nd->ones($shape) } 0..@$keys-1])
=cut

method init(
    Str|ArrayRef[Str] $key,
    AI::MXNet::NDArray|ArrayRef[AI::MXNet::NDArray]|ArrayRef[ArrayRef[AI::MXNet::NDArray]] $value
)
{
    my ($keys, $vals) = _key_value($key, $value);
    check_call(
        AI::MXNetCAPI::KVStoreInitEx(
            $self->handle, scalar(@{ $keys }), $keys, $vals
        )
    );
}

=head2  push

    Push a single or a sequence of key-value pairs into the store.
    Data consistency:
    1. this function returns after adding an operator to the engine.
    2. push is always called after all previous push and pull on the same
        key are finished.
    3. there is no synchronization between workers. One can use _barrier()
    to sync all workers.

    Parameters
    ----------
    key : str or array ref of str
    value : NDArray or array ref of NDArray or array ref of array refs of NDArray
    priority : int, optional
        The priority of the push operation.
        The higher the priority, the faster this action is likely
        to be executed before other push actions.

    Examples
    --------
    >>> # push a single key-value pair
    >>> $kv->push(3, mx->nd->ones($shape)*8)
    >>> $kv->pull(3, out=>$a) # pull out the value
    >>> print $a->aspdl()
        [[ 8.  8.  8.]
        [ 8.  8.  8.]]

    >>> # aggregate the value and the push
    >>> $gpus = [map { mx->gpu($_) } 0..3]
    >>> $b = [map { mx->nd->ones($shape, ctx => $_) } @$gpus]
    >>> $kv->push(3, $b)
    >>> $kv->pull(3, out=>$a)
    >>> print $a->aspdl
        [[ 4.  4.  4.]
        [ 4.  4.  4.]]

    >>> # push a list of keys.
    >>> # single device
    >>> $kv->push($keys, [map { mx->nd->ones($shape) } 0..@$keys-1)
    >>> $b = [map { mx->nd->zeros(shape) } 0..@$keys-1]
    >>> $kv->pull($keys, out=>$b)
    >>> print $b->[1]->aspdl
        [[ 1.  1.  1.]
        [ 1.  1.  1.]]

    >>> # multiple devices:
    >>> $b = [map { [map { mx->nd->ones($shape, ctx => $_) } @$gpus] } @$keys-1]
    >>> $kv->push($keys, $b)
    >>> $kv->pull($keys, out=>$b)
    >>> print $b->[1][1]->aspdl()
        [[ 4.  4.  4.]
        [ 4.  4.  4.]]
=cut

method push(
    Str|ArrayRef[Str] $key,
    AI::MXNet::NDArray|ArrayRef[AI::MXNet::NDArray]|ArrayRef[ArrayRef[AI::MXNet::NDArray]] $value,
    Int :$priority=0
)
{
    my ($keys, $vals) = _key_value($key, $value);
    check_call(
        AI::MXNetCAPI::KVStorePushEx(
            $self->handle, scalar(@{ $keys }), $keys, $vals, $priority
        )
    );
}

=head2 pull

    Pull a single value or a sequence of values from the store.

    Data consistency:

    1. this function returns after adding an operator to the engine. But any
        further read on out will be blocked until it is finished.
    2. pull is always called after all previous push and pull on the same
        key are finished.
    3. It pulls the newest value from the store.

    Parameters
    ----------
    key : str or array ref of str
        Keys
    out: NDArray or array ref of NDArray or array ref of array refs of NDArray
        According values

    priority : int, optional
        The priority of the push operation.
        The higher the priority, the faster this action is likely
        to be executed before other push actions.

    Examples
    --------
    >>> # pull a single key-value pair
    >>> $a = mx->nd->zeros($shape)
    >>> $kv->pull(3, out=>$a)
    >>> print $a->aspdl
        [[ 2.  2.  2.]
        [ 2.  2.  2.]]

    >>> # pull into multiple devices
    >>> $b = [map { mx->nd->ones($shape, $_) } @$gpus]
    >>> $kv->pull(3, out=>$b)
    >>> print $b->[1]->aspdl()
        [[ 2.  2.  2.]
        [ 2.  2.  2.]]

    >>> # pull a list of key-value pairs.
    >>> # On single device
    >>> $keys = [5, 7, 9]
    >>> $b = [map { mx->nd->zeros($shape) } 0..@$keys-1]
    >>> $kv->pull($keys, out=>$b)
    >>> print $b->[1]->aspdl()
        [[ 2.  2.  2.]
        [ 2.  2.  2.]]
    >>> # On multiple devices
    >>> $b = [map { [map { mx->nd->ones($shape, ctx => $_) } @$gpus ] } 0..@$keys-1]
    >>> $kv->pull($keys, out=>$b)
    >>> print $b->[1][1]->aspdl()
        [[ 2.  2.  2.]
        [ 2.  2.  2.]]
=cut

method pull(
    Str|ArrayRef[Str] $key,
    AI::MXNet::NDArray|ArrayRef[AI::MXNet::NDArray]|ArrayRef[ArrayRef[AI::MXNet::NDArray]] :$out,
    Int :$priority=0
)
{
    my ($keys, $vals) = _key_value($key, $out);
    check_call(
        AI::MXNetCAPI::KVStorePullEx(
            $self->handle, scalar(@{ $keys }), $keys, $vals, $priority
        )
    );
}

=head2  set_optimizer

    Register an optimizer to the store

    If there are multiple machines, this process (should be a worker node)
    will pack this optimizer and send it to all servers. It returns after
    this action is done.

    Parameters
    ----------
    optimizer : Optimizer
        the optimizer
=cut

method set_optimizer(AI::MXNet::Optimizer $optimizer)
{
    my $is_worker = check_call(AI::MXNetCAPI::KVStoreIsWorkerNode());
    if($self->type eq 'dist' and $is_worker)
    {
        my $optim_str = MIME::Base64::encode_base64(Storable::freeze($optimizer), "");
        $self->_send_command_to_servers(0, $optim_str);
    }
    else
    {
        $self->_updater(AI::MXNet::Optimizer->get_updater($optimizer));
        $self->_set_updater(sub { &{$self->_updater}(@_) });
    }
}

=head2  type

    Get the type of this kvstore

    Returns
    -------
    type : str
        the string type
=cut

method type()
{
    return scalar(check_call(AI::MXNetCAPI::KVStoreGetType($self->handle)));
}

=head2  rank

    Get the rank of this worker node

    Returns
    -------
    rank : int
        The rank of this node, which is in [0, get_num_workers())
=cut

method rank()
{
    return scalar(check_call(AI::MXNetCAPI::KVStoreGetRank($self->handle)));
}

=head2  num_workers

    Get the number of worker nodes

    Returns
    -------
    size :int
        The number of worker nodes
=cut

method num_workers()
{
    return scalar(check_call(AI::MXNetCAPI::KVStoreGetGroupSize($self->handle)));
}

=head2 save_optimizer_states

    Save optimizer (updater) state to file

    Parameters
    ----------
    fname : str
        Path to output states file.
=cut

method save_optimizer_states(Str $fname)
{
    confess("Cannot save states for distributed training")
        unless defined $self->_updater;
    open(F, ">:raw", "$fname") or confess("can't open $fname for writing: $!");
    print F $self->_updater->get_states();
    close(F);
}

=head2 load_optimizer_states

    Load optimizer (updater) state from file.

    Parameters
    ----------
    fname : str
        Path to input states file.
=cut

method load_optimizer_states(Str $fname)
{
    confess("Cannot save states for distributed training")
        unless defined $self->_updater;
    open(F, "<:raw", "$fname") or confess("can't open $fname for reading: $!");
    my $data;
    { local($/) = undef; $data = <F>; }
    close(F);
    $self->_updater->set_states($data);
}

=head2 _set_updater

    Set a push updater into the store.

    This function only changes the local store. Use set_optimizer for
    multi-machines.

    Parameters
    ----------
    updater : function
        the updater function

    Examples
    --------
    >>> my $update = sub { my ($key, input, stored) = @_;
        ...     print "update on key: $key\n";
        ...     $stored += $input * 2; };
        >>> $kv->_set_updater($update)
        >>> $kv->pull(3, out=>$a)
        >>> print $a->aspdl()
        [[ 4.  4.  4.]
        [ 4.  4.  4.]]
        >>> $kv->push(3, mx->nd->ones($shape))
        update on key: 3
        >>> $kv->pull(3, out=>$a)
        >>> print $a->aspdl()
        [[ 6.  6.  6.]
        [ 6.  6.  6.]]
=cut

method _set_updater(CodeRef $updater_func)
{
    $self->_updater_func(
        sub {
            my ($index, $input_handle, $storage_handle) = @_;
            $updater_func->(
                $index,
                AI::MXNet::NDArray->new(handle => $input_handle),
                AI::MXNet::NDArray->new(handle => $storage_handle)
            );
        }
    );
    check_call(
        AI::MXNetCAPI::KVStoreSetUpdater(
            $self->handle,
            $self->_updater_func
        )
    );
}

=head2 _barrier

    Global barrier between all worker nodes.

    For example, assume there are n machines, we want to let machine 0 first
    init the values, and then pull the inited value to all machines. Before
    pulling, we can place a barrier to guarantee that the initialization is
    finished.
=cut

method _barrier()
{
    check_call(AI::MXNetCAPI::KVStoreBarrier($self->handle));
}

=head2 _send_command_to_servers

    Send a command to all server nodes
    Send a command to all server nodes, which will make each server node run
    KVStoreServer.controller
    This function returns after the command has been executed in all server
    nodes.

    Parameters
    ----------
    head : int
        the head of the command
    body : str
        the body of the command
=cut

method _send_command_to_servers(Int $head, Str $body)
{
    check_call(
        AI::MXNetCAPI::KVStoreSendCommmandToServers(
            $self->handle,
            $head,
            $body
        )
    );
}

=head2 create

    Create a new KVStore.

    Parameters
    ----------
    name : {'local'}
    The type of KVStore
        - local works for multiple devices on a single machine (single process)
        - dist works for multi-machines (multiple processes)
    Returns
    -------
    kv : KVStore
        The created AI::MXNet::KVStore
=cut

method create(Str $name='local')
{
    my $handle = check_call(AI::MXNetCAPI::KVStoreCreate($name));
    return __PACKAGE__->new(handle => $handle);
}

sub _key_value
{
    my ($keys, $vals) = @_;
    if(not ref $keys)
    {
        if(blessed $vals)
        {
            return ([$keys], [$vals->handle]);
        }
        else
        {
            for my $value (@{ $vals })
            {
                assert(blessed($value) and $value->isa('AI::MXNet::NDArray'));
                return ([($keys)x@$vals], [map { $_->handle } @$vals]);
            }
        }
    }
    else
    {
        assert(not blessed($vals) and @$keys == @$vals);
        my @c_keys;
        my @c_vals;
        zip(sub {
            my ($key, $val) = @_;
            my ($c_key, $c_val) = _key_value($key, $val);
            push @c_keys, @$c_key;
            push @c_vals, @$c_val;
        }, $keys, $vals);
        return (\@c_keys, \@c_vals);
    }
}

1;

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

package AI::MXNet::KVStoreServer;
use strict;
use warnings;
use AI::MXNet::Base;
use AI::MXNet::KVStore;
use Storable;
use MIME::Base64;
use Mouse;
use AI::MXNet::Function::Parameters;

=head1 NAME

    AI::MXNet::KVStoreServer - The key-value store server
=cut

=head2 new

    Initialize a new KVStoreServer.

    Parameters
    ----------
    kvstore : KVStore
=cut

has 'kvstore' => (is => 'ro', isa => 'AI::MXNet::KVStore', required => 1);
has 'handle'  => (is => 'ro', isa => 'KVStoreHandle', default => sub { shift->kvstore->handle }, lazy => 1);
has 'init_logging' => (is => 'rw', isa => 'Int', default => 0);


# return the server controller
method _controller()
{
    return  sub { 
        my ($cmd_id, $cmd_body) = @_;
        if (not $self->init_logging)
        {
            ## TODO write logging
            $self->init_logging(1);
        }
        if($cmd_id == 0)
        {
            my $optimizer = Storable::thaw(MIME::Base64::decode_base64($cmd_body));
            $self->kvstore->set_optimizer($optimizer);
        }
        else
        {
            my $rank = $self->kvstore->rank;
            print("server $rank, unknown command ($cmd_id, $cmd_body)\n");
        }
    }
}

=head2 run

    run the server, whose behavior is like
    >>> while receive(x):
    ...     if is_command x: controller(x)
    ...     else if is_key_value x: updater(x)
=cut

method run()
{
    check_call(AI::MXNetCAPI::KVStoreRunServer($self->handle, $self->_controller));
}

# Start server/scheduler
func _init_kvstore_server_module()
{
    my $is_worker = check_call(AI::MXNetCAPI::KVStoreIsWorkerNode());
    if($is_worker == 0)
    {
        my $kvstore = AI::MXNet::KVStore->create('dist');
        my $server = __PACKAGE__->new(kvstore => $kvstore);
        $server->run();
        exit(0);
    }
}

_init_kvstore_server_module();

1;

 view all matches for this distribution
 view release on metacpan -  search on metacpan

( run in 4.900 seconds using v1.00-cache-2.02-grep-82fe00e-cpan-cec75d87357c )