進撃の巨人を読んだことない人がデータだけでキャラを推測してみる - あんちべ！というのが面白そうだったので、毎度おなじみのラブライブ!でネットワーク解析をしてみる。
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 1 遙 0 0 1 28 1 4 渚 7 1 0 0 0 1 真 6 55 4 0 3 13 凜 0 5 0 1 0 0 江 0 0 0 0 0 0
きんいろモザイクもやった。
