#!/usr/bin/perl
#
# 100 simultaneous supernovae collapse into a supermassive blackhole!
# This makes a pretty picture by incrementing the sigma values on the
# sample data resulting in an animated GIF. Please feel free to hack
# it up and post your version!
use strict;
use warnings;
use Imager::Heatmap;
my $filename = 'heatmapa.gif';
my @insert = sample_data();
my @images = ();
$| = 1;
print "Generating GIF frame ";
for my $x ('1'..'90') {
my $hmap = Imager::Heatmap->new(
xsize => 300,
ysize => 300,
xsigma => $x,
ysigma => $x,
);
$hmap->insert_datas(@insert);
push @images, $hmap->draw;
print "$x "
}
print "done!\n";
Imager->write_multi({
file => $filename,
transp => 'none',
gif_loop => 0,
}, @images);
print "Saved $filename\n";
sub sample_data {
my @insert = ();
while (<DATA>) {
chomp; push @insert, [ split /\s/ ]
}
return @insert
}
__DATA__
219.051804229367 88.9872727954212 2.72415838471935
38.8303576772919 95.6603462028621 1.72123666988041
45.1631314764216 268.812149286465 0.804643550395877
66.578264086479 1.22143971287905 2.00653228067716
163.336841980614 147.400715133453 2.87112162284165
197.320137757956 156.07341443269 1.18392267718181
129.67948373001 58.3706442953391 0.803632792287029
206.786042768876 293.853125662186 1.82149200322278
284.623912839804 236.230247601173 2.52708524563815
283.432531746859 149.101459047907 0.774716745801001
26.3156915130299 110.461384379918 2.78433454992581
116.280801427982 298.318189644877 0.889656570195449
260.600329645978 161.876773932393 1.99215632328459
26.5011306311528 256.384608393465 1.38880983326783
83.3079530587614 298.616000219482 2.13076737256037
258.819817681858 63.5060206944549 2.6169114535903
257.616254133365 130.265938008094 1.3196706466417
15.5737558914005 228.476526023456 1.71396074178939
172.958427864326 134.361279761908 0.616677842364464
96.2823219903213 91.610473931559 0.750908991035423
236.961567915958 22.5412194249984 0.733476341421284
33.0355872339999 146.982273461687 1.38645956240103
274.781681119399 277.375471960985 1.28758147461576
274.554895092906 9.64695556856619 2.52964448242347
47.7020972409246 69.3046233133827 2.50824542155272
270.695964570876 174.266969869197 2.58525980872587
150.449885151578 120.725371198669 2.18592811183062
227.822390833157 99.2721473389881 0.86853383233008
186.674904836348 263.644322352447 1.79517340633784
16.2277964745222 89.7084513241149 0.804323118898253
224.121987734913 22.8778173791731 1.4652342209894
114.801624397636 101.908404538988 1.8534394945821
186.063758052809 137.50982170009 2.11562716870688
113.880535534732 124.778518527625 1.79677188736066
256.586035989917 129.649507301872 0.0310617039138883
168.699618610333 194.088909109542 1.52441859325841
229.911780325491 293.672143213136 2.18697827539392
262.394562757206 266.18278106135 0.21784286280419
261.186309813363 279.739283305766 2.65342067631746
172.598778926091 112.915474007112 0.318370872482383
161.474786513763 262.61338263385 1.30891166163741
202.819527123733 116.302152586106 2.98949580198961
44.2752140642415 234.457814079602 0.070243098538878
149.017189910219 67.5233212581507 1.80992425309736
189.78448565856 17.8635011090094 2.84895099057987
171.337181428749 235.505818339764 1.31609788905894
298.763847848466 172.273778698757 1.07685108799202
163.575011025641 133.753537318352 1.41111693520529
185.29670088446 38.7415892388702 1.49994091839003
138.128510267827 201.604577712822 1.56174400372687
92.3971559392572 12.4387771325878 0.431789147416719
251.591916223737 175.434089411266 1.71464686909359
177.979599312939 161.925806575026 1.72004615776216
277.785929330006 250.655954304365 0.0849772369267896
224.114415392595 38.9031874142085 1.14308934159964
198.182388900462 266.666609152744 0.586216710776291
276.396738696131 295.09497084847 2.34086614235889
13.7970156878787 211.201957438183 1.86106049657808
94.0508635177014 109.722540128516 0.69720358584966
78.7046699853789 0.523458727613856 1.21298476973325
160.818115776243 210.942067962107 1.17804568045752
57.3220753369533 44.3129663991423 1.31626080663938
12.4813752912534 220.971653603782 0.999803609658354
240.516981027928 126.105233923117 2.0221446329446
97.5204378748695 258.604994675503 0.990934685034208
116.021835559067 195.835485383258 2.77921016701676
47.7045928108299 24.6872369372347 2.4858777661543
198.725524882548 68.832671189796 0.0116277984877158
263.399127668546 284.004349693855 2.40618731727658
43.294134523476 179.118577091476 0.113292797706293
65.2306402180872 143.466891495816 0.376630609668549
199.359422722217 189.301256344898 0.0399094612900583
280.805205262179 279.296274297957 1.99059111855201
132.242637643764 218.157219786795 1.23879542526741
193.69486843522 10.0438935596493 2.59132699746909
171.127396378509 150.476524305808 2.35057725061366
270.948765280388 74.7769294673688 1.27990336967754
246.381808328795 207.286740227151 2.95748717084632
165.013808799495 157.475790067752 1.12025332499351
141.11136816545 188.2304360916 2.04700091098582
51.898373508318 160.813401405059 0.945193443436867
223.898568651716 206.849446932375 1.84423575399821
236.080016999957 277.636154733142 2.81535531421177
206.507445144285 258.304165009526 0.761047333085337
3.58594137810789 100.98537021846 1.81141974417055
61.7227718623476 200.003718492554 2.32470932299239
220.724602367901 24.650801867741 2.72094047958512
161.47169997666 126.132462200077 1.89587466604485
199.545591065019 65.4269759991849 2.99310639442809
286.248742335322 147.240683827291 2.78527544762646
128.037306298255 2.00280884631425 0.239314932952265
229.465974844797 32.2943462992359 0.975591165237368
273.431292878075 221.745691421587 0.0405515706133492
69.9041882289243 288.210359210613 1.7966328523234
246.013861132753 212.537823993227 2.17469449507044
202.989337138932 233.691516639594 1.85378363737849
240.542733754127 242.813878998893 0.711644744779992
166.54872657784 58.9462742346879 0.927864512940076
277.801370967599 158.887803545861 2.92065009496683
176.548024474562 262.23946790326 0.259036525196102
Re: Animated Heatmap
by bliako (Monsignor) on Aug 11, 2019 at 14:03 UTC
|
#!/usr/bin/perl
#
# 100 simultaneous supernovae collapse into a supermassive blackhole!
# This makes a pretty picture by incrementing the sigma values on the
# sample data resulting in an animated GIF. Please feel free to hack
# it up and post your version!
use strict;
use warnings;
use Imager::Heatmap;
my $filename = 'heatmapa.gif';
my @insert ;
my @images = ();
$| = 1;
print "Generating GIF frame ";
my $text = Imager->new(xsize=>300,ysize=>30);
$text->box(
color => Imager::Color->new(255, 255, 255),
filled=>1
);
my $black = Imager::Color->new("#000000");
my $font = Imager::Font->new(
file => '/usr/share/fonts/open-sans/OpenSans-Semibold.ttf',
color => $black,
size => 25);
my $japh = "Just another Perl hacker,";
$text->string(font=>$font, text=>$japh,
color=>$black, x=>1, y=>20);
$text->write(file=>'fuck.png', type=>'png')
or die "Cannot write: ",$text->errstr;
for my $x (0..299){
for my $y (0..24){
my $pix = ($text->getpixel(x=>$x, y=>$y, type=>'8bit')->rgba())[0]
+;
next if( $pix == 0 );
push @insert, [
$x, $y,
$pix
]
;
}
}
for my $x ('1'..'10') {
my $hmap = Imager::Heatmap->new(
xsize => 300,
ysize => 30,
xsigma => $x,
ysigma => $x,
);
$hmap->insert_datas(@insert);
push @images, $hmap->draw;
print "$x "
}
print "done!\n";
Imager->write_multi({
file => $filename,
transp => 'none',
gif_loop => 0,
}, @images);
print "Saved $filename\n";
bw, bliako | [reply] [d/l] |
|
> here is my lame attempt
I've seen a lot of JAPH, including the best, and this is among them bliako. Very well done! A few updates:
* Fixed font file for macos (ok) and face for win (untested).
* Configure an image size (2x).
* Added flines filter.
#!/usr/bin/perl
# Animated Heatmap
# v1. https://www.perlmonks.org/index.pl?node_id=11104262
# v2. https://www.perlmonks.org/index.pl?node_id=11104285
# v3. This; feel free to hack it up and post your version!
use strict;
use warnings;
use Imager;
use Imager::Filter::Flines;
use Imager::Heatmap;
# Configuration
my $size = { x => 600, y => 60 };
my $japh = 'Just another Perl hacker';
my $filename = 'heatmap_anon_bliako.gif';
# Figure out font
my $fontface
= $^O eq 'MSWin' ? 'Arial'
: $^O eq 'darwin' ? '/System/Library/Fonts/Keyboard.ttf'
: '/usr/share/fonts/open-sans/OpenSans-Semibold.ttf';
my $font = $^O eq 'MSWin'
? Imager::Font->new(
face => $fontface,
size => $size->{x}/12,
aa => 1)
: Imager::Font->new(
file => $fontface,
size => $size->{x}/12,
aa => 1);
STDOUT->autoflush(1);
print "Generating GIF frame ";
# Create the image
my $text = Imager->new(xsize=>$size->{x}, ysize=>$size->{y});
# Generate the text
$text->box(color => Imager::Color->new(255, 255, 255), filled => 1);
$text->string(
font => $font,
text => $japh,
color => Imager::Color->new('#000000'),
x => 1, y => ($size->{x}/12)-1,
);
my @insert = ();
# Scan image of text for heatmap data
for my $x (0..$size->{x}-1) {
for my $y (0..$size->{y}-1) {
my $pix = ($text->getpixel(x=>$x, y=>$y, type=>'8bit')->rgba())[0]
+;
push @insert, [ $x, $y, $pix ]
}
}
my @images = ();
# Generate, draw and filter the heatmap
for my $x (1..10) {
my $hmap = Imager::Heatmap->new(
xsize => $size->{x},
ysize => $size->{y},
xsigma => $x,
ysigma => $x,
);
$hmap->insert_datas(@insert);
$hmap = $hmap->draw;
$hmap->filter(type => 'flines');
push @images, $hmap;
print "$x "
}
print "done!\n";
# Write animated gif
Imager->write_multi({
file => $filename,
transp => 'none',
gif_loop => 0,
}, @images);
# Isn't perl wonderful?
print "Saved $filename\n";
This takes 40 secs on 3.8 GHZ i7 without MCE (hint hint)—OP | [reply] [d/l] |
|
Hi,
On the Mac side, there are library dependencies. I installed extra to cover GIF, PNG, JPEG, and TIFF at least :)
$ brew install giflib libpng libjpeg libtiff freetype
$ cpanm Imager -n
$ cpanm Imager::File::GIF -n
$ cpanm Imager::File::PNG -n
$ cpanm Imager::File::JPEG -n
$ cpanm Imager::File::TIFF -n
$ cpanm Imager::Heatmap -n
Here is the parallel version using MCE::Map.
#!/usr/bin/env perl
# https://www.perlmonks.org/?node_id=11104804
# Animated Heatmap
# v1. https://www.perlmonks.org/index.pl?node_id=11104262
# v2. https://www.perlmonks.org/index.pl?node_id=11104285
# v3. This; feel free to hack it up and post your version!
use strict;
use warnings;
use Imager;
use Imager::Filter::Flines;
use Imager::Heatmap;
use MCE::Map;
# Configuration
my $size = { x => 600, y => 60 };
my $japh = 'Just another Perl hacker';
my $filename = 'heatmap_anon_bliako.gif';
# Figure out font
my $fontface
= $^O eq 'MSWin' ? 'Arial'
: $^O eq 'darwin' ? '/System/Library/Fonts/Keyboard.ttf'
: '/usr/share/fonts/open-sans/OpenSans-Semibold.ttf';
my $font = $^O eq 'MSWin'
? Imager::Font->new(
face => $fontface,
size => $size->{x}/12,
aa => 1)
: Imager::Font->new(
file => $fontface,
size => $size->{x}/12,
aa => 1);
STDOUT->autoflush(1);
print "Generating GIF frame ";
# Create the image
my $text = Imager->new(xsize=>$size->{x}, ysize=>$size->{y});
# Generate the text
$text->box(color => Imager::Color->new(255, 255, 255), filled => 1);
$text->string(
font => $font,
text => $japh,
color => Imager::Color->new('#000000'),
x => 1, y => ($size->{x}/12)-1,
);
my @insert = ();
# Scan image of text for heatmap data
for my $x (0..$size->{x}-1) {
for my $y (0..$size->{y}-1) {
my $pix = ($text->getpixel(x=>$x, y=>$y, type=>'8bit')->rgba())[0]
+;
push @insert, [ $x, $y, $pix ]
}
}
# Generate, draw and filter the heatmap
MCE::Map->init(
max_workers => 10,
chunk_size => 1,
init_relay => ''
);
my @data = mce_map {
my $x = $_;
my $hmap = Imager::Heatmap->new(
xsize => $size->{x},
ysize => $size->{y},
xsigma => $x,
ysigma => $x,
);
$hmap->insert_datas(@insert);
$hmap = $hmap->draw;
$hmap->filter(type => 'flines');
my $data;
$hmap->write(data => \$data, type => 'png');
# calling relay for orderly print output
MCE::relay { print "$x " };
$data;
} [ 1 .. 10 ];
MCE::Map->finish;
print "done!\n";
# Write animated gif
Imager->write_multi({
file => $filename,
transp => 'none',
gif_loop => 0,
}, map { Imager->read_multi(data => \$_) } @data);
# Isn't perl wonderful?
print "Saved $filename\n";
Regards, Mario | [reply] [d/l] [select] |
|
|
|
| [reply] |
|
| [reply] |
Re: Animated Heatmap
by marioroy (Prior) on Aug 24, 2019 at 23:14 UTC
|
Hi,
On the Mac side, I needed to install library dependencies. Thus, installed extra to cover GIF, PNG, JPEG, and TIFF at least :)
$ brew install giflib libpng libjpeg libtiff freetype
$ cpanm Imager -n
$ cpanm Imager::File::GIF -n
$ cpanm Imager::File::PNG -n
$ cpanm Imager::File::JPEG -n
$ cpanm Imager::File::TIFF -n
$ cpanm Imager::Heatmap -n
I tried your example using MCE::Map. It was cool seeing the output from 1 to 90 go by swiftly. So here it is, a parallel demonstration.
#!/usr/bin/env perl
##
# https://www.perlmonks.org/?node_id=11104262
#
# 100 simultaneous supernovae collapse into a supermassive blackhole!
# This makes a pretty picture by incrementing the sigma values on the
# sample data resulting in an animated GIF. Please feel free to hack
# it up and post your version!
##
use strict;
use warnings;
use Imager::Heatmap;
use MCE::Map;
my $filename = 'heatmapa.gif';
my @insert = sample_data();
my @images = ();
$| = 1;
print "Generating GIF frame ";
MCE::Map->init(
max_workers => 20,
chunk_size => 1,
init_relay => ''
);
my @data = mce_map {
my $x = $_;
my $hmap = Imager::Heatmap->new(
xsize => 300,
ysize => 300,
xsigma => $x,
ysigma => $x,
);
$hmap->insert_datas(@insert);
$hmap = $hmap->draw;
my $data;
$hmap->write(data => \$data, type => 'tiff');
# calling relay so orderly print output
MCE::relay { print "$x " };
$data;
} [ 1 .. 90 ];
MCE::Map->finish;
print "done!\n";
Imager->write_multi({
file => $filename,
transp => 'none',
gif_loop => 0,
}, map { Imager->read_multi(data => \$_) } @data);
print "Saved $filename\n";
sub sample_data {
my @insert = ();
while (<DATA>) {
chomp; push @insert, [ split /\s/ ]
}
return @insert
}
__DATA__
...
Regards, Mario | [reply] [d/l] [select] |
|
#!/usr/bin/env perl
##
# https://www.perlmonks.org/?node_id=11104262
#
# 100 simultaneous supernovae collapse into a supermassive blackhole!
# This makes a pretty picture by incrementing the sigma values on the
# sample data resulting in an animated GIF. Please feel free to hack
# it up and post your version!
##
use strict;
use warnings;
use Imager::Heatmap;
use MCE;
my $filename = 'heatmapa.gif';
my @insert = sample_data();
my @images = ();
$| = 1;
print "Generating GIF frame ";
my @data;
MCE->new(
max_workers => 20,
input_data => [ 1 .. 90 ],
chunk_size => 1,
init_relay => '',
gather => sub {
my ($chunk_id) = @_;
$data[ $chunk_id - 1 ] = $_[1];
},
user_func => sub {
my $x = $_;
my $hmap = Imager::Heatmap->new(
xsize => 300,
ysize => 300,
xsigma => $x,
ysigma => $x,
);
$hmap->insert_datas(@insert);
$hmap = $hmap->draw;
my $data;
$hmap->write(data => \$data, type => 'tiff');
# calling relay so orderly print output
MCE::relay {
print "$x ";
MCE->gather(MCE->chunk_id, $data);
};
}
)->run;
print "done!\n";
Imager->write_multi({
file => $filename,
transp => 'none',
gif_loop => 0,
}, map { Imager->read_multi(data => \$_) } @data);
print "Saved $filename\n";
sub sample_data {
my @insert = ();
while (<DATA>) {
chomp; push @insert, [ split /\s/ ]
}
return @insert
}
__DATA__
...
Regards, Mario | [reply] [d/l] |
Re: Animated Heatmap
by bliako (Monsignor) on Aug 11, 2019 at 13:29 UTC
|
| [reply] |
|
|