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