Excellent demonstration as usual, marioroy!
Well, just slightly offtopic, w/r/t/ the efforts
to speed up animated GIF generation
the disturbing truth is that the main time-waster, above, appears to be Imager collecting, in single thread, 999(9...) decoded GIF images into final animation. Just look what it does: GIF files/scalars are read into internal Imager format (thankfully, kept palletized i.e. not converted to "true color"), the LZW compression is discarded/forgotten, it apparently tries palette(s) optimization(?), then individual frames are LZW-compressed again, very likely to the state they were initially stored in files/scalars. What a waste. To be fair, depending on image/scene, quantization requires much more work than LZW compression, so parallelization, as is, pays off well. However, one can't help but wonder if it all can be accelerated.
Actually, yes, some tools appear to be more fit for the job, -- GD. It also, I think, decompresses GIF frames/scalars, but then either keeps (and then uses) originals, or is just optimized 100% ++.
The example below is marioroy's code, with a few changes to setup. I run it on 4 cores, image is slightly larger (to give a computer some work to do, maybe closer to real life use) and has "interesting" background, otherwise compression cancels our larger image size, and it may again be closer to kind of images/animations OP is working with, it seems to me, -- or at least that was an idea. Number of frames, chunk size, etc. are changed according to setup above.
use strict;
use warnings;
use feature 'say';
use Imager;
use MCE::Loop;
use Time::HiRes 'time';
use GD;
STDOUT->autoflush;
my $start = time;
my $count = 0;
my @data;
my $bkg;
my $TEST_GD = $ARGV[ 0 ] // 1;
MCE::Loop->init(
max_workers => MCE::Util::get_ncpu(),
chunk_size => 40,
init_relay => '',
gather => sub {
if (@_ == 1) {
print "\r", $count++;
} else {
push @data, @{ $_[1] };
}
},
user_begin => sub {
$bkg = Imager->new(xsize=>800, ysize=>600);
$bkg->filter(type=>"gradgen",
xo=>[ 100, 300, 600 ],
yo=>[ 100, 300, 100 ],
colors=>[ qw(red blue green) ]);
$bkg->filter(type=>"noise", amount=>12, subtype=>0)
},
);
mce_loop {
my ($mce, $chunk_ref, $chunk_id) = @_;
my @i_data;
for my $x (@{ $chunk_ref }) {
my $i = $bkg-> copy;
$i->string(
text => $x,
color => Imager::Color->new('ffffff'),
font => Imager::Font->new(
# file => '/usr/share/fonts/truetype/msttcorefonts/cour.ttf',
# file => '/System/Library/Fonts/Courier.dfont',
face => 'Courier New', # mswin
size => 420,
aa => 1),
x => 25,
y => 500,
);
$i->write(data => \my $data, type => 'gif');
push @i_data, $data;
MCE->gather($x);
}
MCE::relay { MCE->gather($chunk_id, \@i_data) };
} [ 0 .. 319 ];
MCE::Loop->finish;
print " frame GIF done!\n";
printf "compute time: %0.3fs\n", time - $start;
if ( $TEST_GD ) {
my $image = GD::Image-> newFromGifData( $data[ 0 ]);
my $gifdata = $image-> gifanimbegin(0,0);
$gifdata .= $image-> gifanimadd( 1,0,0,1,1 );
for (1..$#data) {
my $frame = GD::Image-> newFromGifData( $data[ $_ ]);
$gifdata .= $frame-> gifanimadd( 1,0,0,1,1 );
}
$gifdata .= $image-> gifanimend;
open my $fh, '>', 'gd.gif';
binmode $fh;
print $fh $gifdata;
close $fh;
}
else {
Imager->write_multi({
file => 'im.gif', type => 'gif', gif_loop => 0, gif_delay => 1,
}, map { Imager->new(data => \$_) } @data) or die Imager->errstr;
}
printf "Total: %0.3fs\n", time - $start;
__END__
319 frame GIF done!
compute time: 10.932s
Total: 45.646s
319 frame GIF done!
compute time: 10.738s
Total: 17.107s
1st is testing (final animation to be collected by) Imager, 2nd -- GD. Nice. But then, from here it's natural to also parallelize what's being collected in "$gifdata" -- staying in the same "mce_loop" block! 2 fragments: (1) a "push" to be replaced with (should be re-written better, it's too late here already):
if ( $TEST_GD ) {
my $gd = GD::Image-> newFromGifData( $data );
push @i_data, !$x
? $gd-> gifanimbegin .
$gd-> gifanimadd( 1,0,0,1,1 )
: $gd-> gifanimadd( 1,0,0,1,1 )
}
else {
push @i_data, $data
}
and (2) final "if" to be replaced with:
if ( $TEST_GD ) {
open my $fh, '>', 'gd.gif';
binmode $fh;
print $fh join '', @data;
close $fh;
}
else {
Imager->write_multi({
file => 'im.gif', type => 'gif', gif_loop => 0, gif_delay => 1,
}, map { Imager->new(data => \$_) } @data) or die Imager->errstr;
}
__END__
319 frame GIF done!
compute time: 11.765s
Total: 12.015s
Now that's some "speeding up animated GIF generation". The whole test -- using Imager to generate a GIF, then GD to re-save -- is maybe somewhat artificial as an example, and may or may not be close to "real life". Just to show that parallelization (== optimization) helps as much as other tools/setup allow.
| [reply] [d/l] [select] |
gather => sub {
if (@_ == 1) {
print "\r", $count++;
}
else {
if (!defined $gifdata) {
$image = GD::Image-> newFromGifData( shift @{ $_[1] } );
$gifdata = $image-> gifanimbegin( 0,0 );
$gifdata .= $image-> gifanimadd( 1,0,0,1,1 );
}
while ( my $data = shift @{ $_[1] } ) {
my $frame = GD::Image-> newFromGifData( $data );
$gifdata .= $frame-> gifanimadd( 1,0,0,1,1 );
}
}
},
That results in workers waiting for the manager process which is fine (i.e. the manager process is now the bottleneck). In that case chunk_size 1 may be faster to have the manager process quickly add one frame. Thereby able to respond to other workers with lesser latency.
use strict;
use warnings;
use feature 'say';
use Imager;
use MCE::Loop;
use Time::HiRes 'time';
use GD;
STDOUT->autoflush;
my $start = time;
my $count = 0;
my $bkg;
my $image;
my $gifdata;
MCE::Loop->init(
max_workers => MCE::Util::get_ncpu(),
chunk_size => 1,
init_relay => '',
gather => sub {
if (@_ == 1) {
print "\r", $count++;
}
else {
if (!defined $gifdata) {
$image = GD::Image-> newFromGifData( shift @{ $_[1] } );
$gifdata = $image-> gifanimbegin( 0,0 );
$gifdata .= $image-> gifanimadd( 1,0,0,1,1 );
}
while ( my $data = shift @{ $_[1] } ) {
my $frame = GD::Image-> newFromGifData( $data );
$gifdata .= $frame-> gifanimadd( 1,0,0,1,1 );
}
}
},
user_begin => sub {
$bkg = Imager->new(xsize=>800, ysize=>600);
$bkg->filter(type=>"gradgen",
xo=>[ 100, 300, 600 ],
yo=>[ 100, 300, 100 ],
colors=>[ qw(red blue green) ]);
$bkg->filter(type=>"noise", amount=>12, subtype=>0)
},
);
mce_loop {
my ($mce, $chunk_ref, $chunk_id) = @_;
my @i_data;
for my $x (@{ $chunk_ref }) {
my $i = $bkg-> copy;
$i->string(
text => $x,
color => Imager::Color->new('ffffff'),
font => Imager::Font->new(
# file => '/usr/share/fonts/truetype/msttcorefonts/cour.ttf', #
+ Ubuntu
# file => '/System/Library/Fonts/Courier.dfont',
face => 'Courier New', # mswin
size => 420,
aa => 1),
x => 25,
y => 500,
);
$i->write(data => \my $data, type => 'gif');
push @i_data, $data;
MCE->gather($x);
}
MCE::relay { MCE->gather($chunk_id, \@i_data) };
} [ 0 .. 319 ];
MCE::Loop->finish;
print " frame GIF done!\n";
printf "compute time: %0.3fs\n", time - $start;
$gifdata .= $image-> gifanimend;
open my $fh, '>:raw', 'gd.gif';
print $fh $gifdata;
close $fh;
printf "Total: %0.3fs\n", time - $start;
Regards, Mario | [reply] [d/l] [select] |