pixivのタグ頻度から考えるラブライブのカップリング

MikuHatsune2013-09-05

進撃の巨人を読んだことない人がデータだけでキャラを推測してみる - あんちべ!というのが面白そうだったので、毎度おなじみのラブライブ!でネットワーク解析をしてみる。
pixivの小説からタグを取ってくる。作業は pixiv というフォルダとする。

# Rで
tag <- "ラブライブ"
page <- 1000
urls <- paste("http://spapi.pixiv.net/iphone/search_novel.php?s_mode=s_tag&p=", seq(page), "&word=", tag, sep="")
write.table(urls, "urls.txt", row.names=FALSE, col.names=FALSE, quote=FALSE)

こうして出来た urls.txt を wget を使って取得する。

# ターミナルで
cd pixiv
wget -i urls.txt

Rを使ってタグ頻度を計算する。

setwd("pixiv")
fs <- list.files()
data0 <- NULL
for(i in seq(fs)){
	pb <- txtProgressBar(min=1, max=length(fs), style=3)
	setTxtProgressBar(pb, i)
	data0 <- rbind(data0, read.csv(fs[i], header=FALSE))
}

tag <- strsplit(as.character(unique(data0$V14)), " ")
freq <- table(unlist(tag))

百合カップリングの「にこまき」を取ってくる。百合はBLと違って名前の順番による攻め受けがないらしい(ピクシブ百科事典の百合)らしいけど、ひっくり返しているものもあったので別にカウントしておく。
にこまきの圧倒的多さ。

mem <- c("こと", "うみ", "ほの", "りん", "ぱな", "まき", "のぞ", "えり", "にこ")
couple <- outer(mem, mem, paste, sep="")
res <- diag(0, length(mem))
dimnames(res) <- list(mem, mem)

for(i in seq(tag)){
	res[couple %in% tag[[i]]] <- res[couple %in% tag[[i]]] + 1
}
res
	こと	うみ	ほの	りん	ぱな	まき	のぞ	えり	にこ
こと	0	23	7	0	1	0	0	1	0
うみ	6	0	2	1	0	2	0	3	0
ほの	0	1	0	0	0	9	3	14	2
りん	0	0	0	0	10	7	0	0	0
ぱな	0	0	0	0	0	0	0	0	0
まき	0	2	1	1	2	0	0	1	0
のぞ	0	0	0	0	0	1	0	15	2
えり	0	17	1	0	0	2	7	0	0
にこ	0	0	0	0	0	33	0	1	0

グラフを描く。攻め受け的な頻度で2本のエッジを引きたかったけどよくわからなかったので保留。名前だけだと寂しいのでpng貼った
グラフレイアウトを指定できるのだが、それを使って得た座標がなぜかずれていてうまく png がプロットできなかったので locator でポチポチ座標を取得する。
 
20140303追記 plot.igraphでscace=FALSEにするか、layout.norm関数で補正すれば合う。
 
結果としては
にこまきが一番多い。
よくあるカップリングは、にこまき、ことうみ、のぞえり。
2年生組で高坂穂乃果が一番モテているのかと思いきや、実はことうみが多い。
東條希は攻め的なポジションが多いのかと思いきや、受け的なポジションも多い。
小泉花陽ちゃんは総受け。1年生組は西木野真姫以外他学年との絡みが少ない。

library(png)
# 適当なところから png を取ってきておく。
pics <- vector("list", 9)
for(i in seq(9)){
	pics[[i]] <- readPNG(paste("~/Desktop/schfes/", i, ".png", sep=""), native=TRUE)
}
ra <- 1 #原点に近いところが潰れるので拡大したかったけど、等倍でやった。
xy0 <- sapply(pics, dim)[1:2, ] #pixel
rownames(xy0) <- c("height", "width")
s0 <- 0.005 #拡大縮小率

library(igraph)
g0 <- graph.adjacency(res)
V(g0)$size <- 30
V(g0)$color <- NA
V(g0)$frame.color <- NA
V(g0)$shape <- "square"
lay <- layout.auto(g0)
plot(g0, layout=lay)
title("pixiv小説タグ頻度から考えたラブライブカップリング")

lay0 <- locator(seq(mem))
for(i in seq(pics)){
	xleft=lay0[i, 1]*ra - xy0[2, i]/2*s0
	ybottom=lay0[i, 2]*ra - xy0[1, i]/2*s0
	xright=lay0[i, 1]*ra + xy0[2, i]/2*s0
	ytop=lay0[i, 2]*ra + xy0[1, i]/2*s0
	rasterImage(image=pics[[i]], xleft=xleft, ybottom=ybottom, xright=xright, ytop=ytop, xpd=TRUE)
}


ゆるゆりで作って欲しいという要望があったので作った。画像は面倒なので略。

最近はやりのFree!が気になりすぎてやばい精神状態になったのでやった。

	怜	遙	渚	真	凜	江
怜	0	0	7	0	0	10	0	1	28	1	47	1	0	0	0	16	55	4	0	3	130	5	0	1	0	00	0	0	0	0	0


きんいろモザイクもやった。