view release on metacpan or  search on metacpan

examples/mnist.pl  view on Meta::CPAN

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