グラフデータの取得が終わったので、取得したデータを解析。
PNGから言及数を解析する
この辺。
「2006年声優言及数」の検索結果 - XXXannex
結構泥臭い感じで、libpngを使って解析。こういうのはCでやった方が簡単かなー。
今年の罠としては、グラフのボーダーの色が変わってるというところ。
こっちが去年のグラフ。
PNGのパレット情報（PLTEチャンク）。
chunk PLTE: --------------------------------- entries: 6 0: (ff, ff, ff) 1: (00, ff, 00) 2: (ff, 00, 00) 3: (7f, 7f, 7f) 4: (00, 00, 00) 5: (52, 79, e7)
こっちが今年のグラフ。
パレット情報。
chunk PLTE: --------------------------------- entries: 6 0: (ff, ff, ff) 1: (00, ff, 00) 2: (ff, 00, 00) 3: (7f, 7f, 7f) 4: (00, 00, 00) 5: (33, 33, 33)
おそらくキーワードの仕様変更に伴ってグラフ周りも変わったと思うんだけど、ボーダーが水色(52, 79, e7)から黒(33, 33, 33)に変わっている！去年のプログラムがうまく動かなくて焦ったけど、どうやらそういうことらしい。ボーダーの色の変更をプログラムに反映させるとうまく動きました。しかし、ボーダーの色と文字の色が同じになってしまっていたら、もっと大規模な変更を余儀なくされたなあ・・・。ぱっと見、色の区別が付かなかったから心配したよ。
グラフの正当性チェック
作りたてのキーワードだと「情報を取得できません」という画像が表示されてしまうようです。
pngcheck Home Page からpngcheckをダウンロードして*1チェックしてみる。
$ pngcheck -pv %C6%A3%B5%C8%B5%D7%C8%FE%BB%D2_2008-12-31_365.png
File: %C6%A3%B5%C8%B5%D7%C8%FE%BB%D2_2008-12-31_365.png (2187 bytes)
chunk IHDR at offset 0x0000c, length 13
400 x 200 image, 8-bit colormap, non-interlaced
chunk gAMA at offset 0x00025, length 4: 0.45000
chunk tEXt at offset 0x00035, length 25, keyword: Software
chunk PLTE at offset 0x0005a, length 12 PLTE chunk: 4 palette entries
0: ( 82,121,231) = (0x52,0x79,0xe7)
1: (179,179,179) = (0xb3,0xb3,0xb3)
2: ( 0, 0, 0) = (0x00,0x00,0x00)
3: (255,255,255) = (0xff,0xff,0xff)
chunk IDAT at offset 0x00072, length 2053
zlib: deflated, 32K window, maximum compression
chunk IEND at offset 0x00883, length 0
No errors detected in %C6%A3%B5%C8%B5%D7%C8%FE%BB%D2_2008-12-31_365.png (97.3% compression).普通の（？）グラフデータのヘッダー構造はこんな感じ。色々違います。
$ pngcheck -pv %A1%BA%CC%EE%BD%E1%BB%D2_2008-12-31_365.png
File: %A1%BA%CC%EE%BD%E1%BB%D2_2008-12-31_365.png (1651 bytes)
chunk IHDR at offset 0x0000c, length 13
400 x 200 image, 4-bit colormap, interlaced
chunk PLTE at offset 0x00025, length 18 PLTE chunk: 6 palette entries
0: (255,255,255) = (0xff,0xff,0xff)
1: ( 0,255, 0) = (0x00,0xff,0x00)
2: (255, 0, 0) = (0xff,0x00,0x00)
3: (127,127,127) = (0x7f,0x7f,0x7f)
4: ( 0, 0, 0) = (0x00,0x00,0x00)
5: ( 51, 51, 51) = (0x33,0x33,0x33)
chunk tRNS at offset 0x00043, length 1 tRNS chunk: 1 transparency entry
0: 0 = 0x00
chunk IDAT at offset 0x00050, length 1551
zlib: deflated, 32K window, default compression
chunk IEND at offset 0x0066b, length 0
No errors detected in %A1%BA%CC%EE%BD%E1%BB%D2_2008-12-31_365.png (95.9% compression).藤吉久美子とは - はてなキーワードを見ると、キーワードが作成されたのが1/1だから、その辺の都合のようですね。
一通りチェックしたら解析ツールにかける。
$ ls | xargs readpng > readpng.out
こんなかんじで。前は1ファイルずつやっていたんだけど、ファイル数が多くなると時間がかかってしまうので、複数ファイルを受け入れられるようにしました。
月ごとにマージ
readpngは、こんな感じの出力を出します。
input file: [%B9%E2%B3%C0%BA%CC%CD%DB_2008-12-31_365.png]
png signature: 89 50 4e 47 0d 0a 1a 0a
graph border: t=17 b=161 l=27 r=389
max_value area: sh=13 sw=0 eh=20 ew=27
33 3333
3 3 3
3 333
3 3
3 3
3 3 3
3333 33
max_value bit_pattern:
00000000000011001111000000000000
00000000000100101000000000000000
00000000000000101110000000000000
00000000000001000001000000000000
00000000000010000001000000000000
00000000000100001001000000000000
00000000000111100110000000000000
max_value hex_pattern: {0x000cf000, 0x00128000, 0x0002e000, 0x00041000, 0x00081000, 0x00109000, 0x001e6000, },
count_max: 25.0
start point:(h=16, w=28)
end point :(h=161, w=389)
count:1.03 2.07 2.41 2.93 5.52 8.97 4.48 1.55 2.07 1.03 1.38 3.97 5.00 3.45 1.03 1.03 1.03 2.93 3.97 3.45 1.38 0.00 ......グラフの最大値を求めるために、ビットマップのマッピングを決め打ちで見る、という結構泥臭い感じですが、これでも結構うまく行くんだよね。
それはともかく。出力中のinput fileとcountの項目にデータが入っているのですが、これは単に数字を読み取っただけなので、ここから月ごとのカウントをマージする必要があります。プログラム内部でそこまでやってもいいんだけど、まあ、作業は分割した方がシンプルに行くので、ここはスクリプトで解析させることに。
use strict; use warnings; use File::Basename; use POSIX; use Date::Simple qw(:all); use List::Util qw(sum); use List::MoreUtils qw(any); use URI::Escape; # use Smart::Comments; ## usage: $0 start[YYYYMM] end[YYYYMM] < readpng.out my $start = shift; my $end = shift; my @count_range = make_range_keys($start, $end); die("count_range is null") unless(@count_range); ## data structure ## %count{$name} = { ## YYYYMM => count # by month ## or ## YYYYWW => count # by week ## } # notice: filename must be "<URI-escaped name>_YYYY-MM-DD_RANGE.png" my ($name, $year, $month, $day, $range, @lines); while(<>){ tr/\x0D\x0A//d; if(/^input file: \[(.+)\]$/){ scalar(fileparse($1, '.png')) =~ /(.+)_(\d{4})\-(\d{2})\-(\d{2})_(\d+)/o; ($name, $year, $month, $day, $range) = ($1, $2, $3, $4, $5); die('specify "<URI-escaped name>_YYYY-MM-DD_RANGE.png" as input file!') if any { !$_ } ($name, $year, $month, $day, $range); } if(/^count:(.+)/){ my @count = map { ($_ < 0) ? 0 : $_} split(/\s+/, $1); # count=-1 if no data push(@lines, [$name, $year, $month, $day, $range, @count]); ($name, $year, $month, $day, $range) = (-1, -1, -1, -1, -1); } } my $count = count_by_month(\@lines); print join("\t", (qw(key name), @count_range)) . "\n"; foreach my $name (keys %$count){ print "$name\t" . URI::Escape::uri_unescape($name); foreach my $ym (@count_range){ my $v = $count->{$name}->{$ym}; print "\t", (($v) ? $v : 0); } print "\n"; } sub make_range_keys{ my $start = d8($_[0] . "01") || return; my $end = d8($_[1] . "01") || return; my @range; for(my $i=$start; $i<=$end; $i += days_in_month($i->year, $i->month)){ push(@range, $i->format('%Y%m')); } return @range; } sub count_by_month{ my $lines = shift; my %count; foreach(@$lines){ my ($name, $year, $month, $day, $range, @count) = @$_; my $d_end = date(sprintf("%04d%02d%02d", $year, $month, $day)); my $d_start = $d_end - $range; my %m_range; for(my $i=$d_start; $i<=$d_end; $i=$i->next()){ $m_range{$i->format('%Y%m')}++; } my @m_range_keys = sort keys(%m_range); my @m_range_value = @m_range{@m_range_keys}; @m_range_value = map{$_ * @count/sum(@m_range_value)} cumsum(@m_range_value); my @count_cum = (0, cumsum(@count)); my @count_by_month; foreach my $n (@m_range_value){ my $p = ceil($n) - 1; # 1.5 -> 1+0.5, 2.0 -> 1+1.0 : 1 = right hand side of cumsum(count)[0] push(@count_by_month, $count_cum[$p] + $count[$p]*($n-$p)); } @count_by_month = ($count_by_month[0], diff(@count_by_month)); # store to table my %h; @h{@m_range_keys} = @count_by_month; $count{$name} = {%h}; } return \%count; } sub cumsum{ my $v = 0; map{ $v+=$_; } @_; } sub diff{ map { $_[$_] - $_[$_-1] } (1..$#_) }
シンプルにこんな感じですかね。（ちょっと早くした →）
$ perl readpng2r.pl 200801 200812 < readpng.out > readpng2r.out
readpng2rのネーミングの由来は、確かこのあとRで解析する予定だったから・・・のはず。
key name 200801 200802 200803 ... %B9%E2%B3%C0%BA%CC%CD%DB 高垣彩陽 68.7397814207651 35.5718579234972 119.016475409836 ...
こんな感じで出力されてきます。
過去データとマージ
過去のデータとマージします。まあ、この辺もシンプルに作っておきます。
use strict; use warnings; use List::MoreUtils qw(uniq); use URI::Escape; # usage: $0 file1 file2 # input data format: # key name 200801 200802 200803 ... # %B9%E2%B3%C0%BA%CC%CD%DB 高垣彩陽 68.7397814207651 35.5718579234972 119.016475409836 ... my ($head_0, $count_0) = readfile($ARGV[0]); my ($head_1, $count_1) = readfile($ARGV[1]); print join("\t", qw(key name), @$head_0, @$head_1) . "\n"; foreach my $n (sort(uniq(keys %$count_0, keys %$count_0))){ print "$n\t" . URI::Escape::uri_unescape($n) . "\t"; print join("\t", ($count_0->{$n} ? @{$count_0->{$n}} : (0) x @$head_0)); print "\t"; print join("\t", ($count_1->{$n} ? @{$count_1->{$n}} : (0) x @$head_1)); print "\n"; } sub readfile{ my $infile = shift; open(F, $infile) || die("can't open $infile"); my ($head, @lines) = map{ tr/\x0A\x0D//d; $_ } <F>; my @header = split(/\t/, $head); my %count = map{ my ($key, undef, @cnt) = split(/\t/); ($key => [@cnt]); } @lines; return([@header[2 .. $#header]], \%count); # exclude first two data(key,name) in header }
*1:他のものでもいいけど・・・libpngのお手本としては見ておくべき
