2006 年 2 月 16 日 23 時 12 分

利用頻度……その前に(クロージャ遊び)


このアーカイブは同期化されません。 mixi の日記が更新されても、このアーカイブには反映されません。


いきなり私事で恐縮だが、業務案件の納期が迫っているため、
最近はあまり時間が割けなくなってきた。
申し訳ないが、少しペースダウンするかもしれない。

さて、気を取り直して昨日のつづきをば。
……え~と、使用頻度を計算するっだったか。

昨日は 109 色という結果がでた。
実は色数は既存のツールを使って計算したのだが、
利用頻度までは分からない。

109 色と言っても、色が満遍なく使われているならいいが、
おそらく偏っているはずだ。
もし、1 回やそこらしか使っていない色があったなら、
わざわざその色のためにカラーテーブルを使う価値はない。
それを調べるために、利用頻度を考えたいのだ。

さて、今まで紹介してきた画像処理は、
全て 24 もしくは 32 ビットの BMP を対象にしていた。
今日調べたいのは、8 ビット以下の BMP であるので、
先に BMP を読み取るためのルーチンを拡張する必要がある。

今日はクロージャで遊んでみよう。


# 標準入力から BMP を読み込む
sub read_bmp () {
    use integer;

    # 必ずバイナリで。
    binmode(STDIN);

    # 読み取りバッファ。
    my $chunk;

    # 読み取り位置。
    my $pos = 0;

    # 指定バイト標準入力から読み込むクロージャ。
    # $chunk に読み、読んだ分だけ $pos を加算。
    # 指定長読めないと die する。$chunk, $pos を束縛。
    my $read_exact = sub ($) {
        my $size = shift;
        my $read = read(STDIN, $chunk, $size);
        defined $read or die $!;
        $read == $size or die 'Data truncated.';
        $pos += $read;
    };

    # BITMAPFILEHEADER 読み込み。
    $read_exact->(14);
    my ($signature, $data_offset) = unpack('a2x8V', $chunk);

    # 'BM' チェック。
    $signature eq 'BM' or die 'Invalid signature.';

    # BITMAPINFOHEADER 読み込み。
    $read_exact->(40);
    my ($bih_size, $width, $height, $planes,
        $bit_count, $compression, $color_count)
      = unpack('VVVvvVx12Vx4', $chunk);

    # 40 未満のサイズは古い形式なので対応しない。
    $bih_size >= 40 or die 'OS/2 bitmaps not supported.';

    # BMP は必ず 1 プレーン(面)。
    $planes == 1 or die 'Invalid bitmap.';

    # ビット数は 1, 4, 8, 16, 24, 32 のどれか。
    grep { $bit_count == $_ } (1, 4, 8, 16, 24, 32)
      or die 'Not supported bit count.';

    # 圧縮は今回扱わない。
    $compression == 0 or die 'Not supported compression.';

    # 8 ビット以下の BMP はカラーテーブルを持つ。
    if ($color_count == 0 and $bit_count <= 8) {
        $color_count = 2 ** $bit_count;
    }

    # ヘッダが 40 バイトを超える場合残りを読み飛ばす。
    if ($bih_size > 40) {
        $read_exact->(40);
    }

    # カラーテーブル。
    my $colors;

    # カラーテーブルがあれば読み込む。
    if ($color_count) {
        $read_exact->($color_count * 4);
        # "V16" などのテンプレートで配列化。
        $colors = [ unpack("V$color_count", $chunk) ];
    }

    # 標準入力は seek できないのでデータ部まで読み捨て。
    if ($data_offset - $pos) {
        $read_exact->($data_offset - $pos);
    }

    # 行のバイト数を計算。
    my $line_size = int(($width * $bit_count + 31) / 32) * 4;

    # 行リファレンスの配列。ここに結果が入る。
    my @data = ();

    # トップダウンの BMP の場合高さが負の値。
    # 順番に処理した場合、配列に追加する場所が異なる。
    # そこで @data を束縛する行追加用のクロージャを作る。
    my $insert = $height < 0
      ? sub { push(@data, $_[0]) }
      : sub { unshift(@data, $_[0]) }
    ;

    # 行データ処理用のクロージャを作る。
    # $chunk, $width, $insert を束縛。

    my $process_line =
      $bit_count == 32 ?
        sub {
            $insert->([ unpack('V*', $chunk) ]);
        }
    : $bit_count == 24 ?
        sub {
            my $line = [
              map { unpack('V', $_ . "\0") }
                $chunk =~ /.{3}/sg
            ];
            $#$line = $width - 1;
            $insert->($line);
        }
    : $bit_count == 16 ?
        sub {
            my $line = [ unpack('v*', $chunk) ];
            $#$line = $width - 1;
            $insert->($line);
        }
    : # $bit_count <= 8
        sub {
            my $bits = unpack('B*', $chunk);
            my $line = [
              map { ord pack('b8', scalar reverse $_) }
                $bits =~ /.{$bit_count}/sg
            ];
            $#$line = $width - 1;
            $insert->($line);
        }
    ;

    # データを読み込む。
    $height = -$height if $height < 0;
    foreach (1 .. $height) {
        $read_exact->($line_size);
        $process_line->();
    }

    # 戻り値を拡張し、スカラコンテキストならデータだけ、
    # リストコンテキストなら、データを先頭に、
    # ビット数、カラーテーブルの 3 要素の配列を返す。
    # write_bmp の引数と同じ並び順だ。
    wantarray ? (\@data, $bit_count, $colors) : \@data;
}


さて、明日はこれを使って色の利用頻度を調べよう。



Copyright (c) 1994-2007 Project Loafer. All rights reserved.