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

ちなみに、入力した画像はこちら。
20140726-1

この結果だけ見ると、やはり背景に色があった方が分離しやすいかな、と。
今回は、明るさ(Value)で分離するのが良さそう。

おしまい。

Leave a Comment