Imagerで画像の統計を取る
今日は普通にImagerを使おうと思う。
ピクセル単位でアクセスするには、Imager::Drawが参考になると思う。
1ラインずつアクセスするとこんな感じになる。
use v5.14;
use strict;
use warnings;
use Imager;
use Time::HiRes qw/time/;
if ( (not @ARGV) or (not -e $ARGV[0]) ) {
say "Usage:
perl $0 file_path";
exit( 0 );
}
my $img_src = Imager->new( file => $ARGV[0] )
or die Imager->errstr();
say 'w = ', $img_src->getwidth(), ', h = ', $img_src->getheight();
my $start = time();
my $n = 0;
my $iy = $img_src->getheight();
while ( 0 < $iy-- ) {
my @colors = $img_src->getscanline( y => $iy );
$n += scalar(@colors);
}
say sprintf("%.2f", time() - $start), 'sec';
say 'sum = ', $n;
これを実行するとこんな感じ。
$ perl aaa.pl IMGP0282.JPG
w = 4000, h = 3000
7.85sec
sum = 12000000
1,200万画素だと、こんな感じでアクセスするだけでも8秒弱掛かる。
他にもアクセスの仕方はあるけど、今回はHSVで統計を取りたかったので、
画像を縮小して統計を取ろうと思う。
use v5.14;
use strict;
use warnings;
use Imager;
use Time::HiRes qw/time/;
if ( (not @ARGV) or (not -e $ARGV[0]) ) {
say "Usage:
perl $0 file_path";
exit( 0 );
}
my $img_src = Imager->new( file => $ARGV[0] )
or die Imager->errstr();
my $img_dst = $img_src->scale( scalefactor => 0.25 );
say 'w = ', $img_dst->getwidth(), ', h = ', $img_dst->getheight();
my $start = time();
my $n = 0;
my $iy = $img_dst->getheight();
while ( 0 < $iy-- ) {
my @colors = $img_dst->getscanline( y => $iy );
$n += scalar(@colors);
}
say sprintf("%.2f", time() - $start), 'sec';
say 'sum = ', $n;
$img_dst->write( file => $0 . '_thumb.jpg' );
$ perl bbb.pl IMGP0282.JPG
w = 1000, h = 750
0.50sec
sum = 750000
これだと、統計を取る処理を追加しても待てそう。
use v5.14;
use strict;
use warnings;
use Imager;
use Time::HiRes qw/time/;
use List::Util qw/max/;
use constant {
STAT_SIZE => 10
};
if ( (not @ARGV) or (not -e $ARGV[0]) ) {
say "Usage:
perl $0 file_path";
exit( 0 );
}
my $img = Imager->new( file => $ARGV[0] )
or die Imager->errstr();
say 'w = ', $img->getwidth(), ', h = ', $img->getheight();
my $start = time();
my $n = 0;
my @stat_h = map { 0; } 0..(STAT_SIZE - 1);
my @stat_s = map { 0; } 0..(STAT_SIZE - 1);
my @stat_v = map { 0; } 0..(STAT_SIZE - 1);
my $iy = $img->getheight();
while ( 0 < $iy-- ) {
my @colors = $img->getscanline( y => $iy );
foreach my $c (@colors) {
my ($h, $s, $v, undef) = $c->hsv();
$h = int(($h / 360.0) * STAT_SIZE);
$s = int($s * STAT_SIZE);
$v = int($v * STAT_SIZE);
$stat_h[ (STAT_SIZE - 1) < $h ? (STAT_SIZE - 1) : $h ]++;
$stat_s[ (STAT_SIZE - 1) < $s ? (STAT_SIZE - 1) : $s ]++;
$stat_v[ (STAT_SIZE - 1) < $v ? (STAT_SIZE - 1) : $v ]++;
}
$n += scalar(@colors);
}
say '=' x 4, ' hue ', '=' x 4;
{
my $cnt_max = max @stat_h;
for (my $i=0; $i<scalar(@stat_h); $i++) {
say "$i: ", '*' x int(($stat_h[$i] / $cnt_max) * 20);
}
}
say '=' x 4, ' sat ', '=' x 4;
{
my $cnt_max = max @stat_s;
for (my $i=0; $i<scalar(@stat_s); $i++) {
say "$i: ", '*' x int(($stat_s[$i] / $cnt_max) * 20);
}
}
say '=' x 4, ' value ', '=' x 4;
{
my $cnt_max = max @stat_v;
for (my $i=0; $i<scalar(@stat_v); $i++) {
say "$i: ", '*' x int(($stat_v[$i] / $cnt_max) * 20);
}
}
say '=' x 4, ' time ', '=' x 4;
say sprintf("%.2f", time() - $start), 'sec';
say 'sum = ', $n;
結果はこんな感じ。
$ perl ccc.pl 20140726-1.jpg
w = 1000, h = 750
==== Hue ====
0: ***********
1: ********************
2:
3:
4:
5:
6:
7:
8:
9:
==== Sat ====
0: ********************
1: ***********
2: *
3:
4:
5:
6:
7:
8:
9:
==== Value ====
0:
1: ***
2: ********************
3: ********
4:
5:
6: *
7: **
8: ****
9: *
==== Time ====
2.51sec
sum = 750000
この結果だけ見ると、やはり背景に色があった方が分離しやすいかな、と。
今回は、明るさ(Value)で分離するのが良さそう。
おしまい。

Leave a Comment