ラブライブ!というアニメがある。
内容は廃校寸前の学園からアイドル活動を通じて学園を立て直そう的なものなのだが、出ている声優が初めて聞く人が多くて注目している。
そのなかでメインとなる9人のメンバーがいるのだが
身長やスリーサイズといったプロフィールが公式設定で存在している。
ラブライブ!はユーザー参加型企画らしいのだが、どのキャラが好きかどうか決めないと先に進まないだろうから、彼女らをどうにか特徴付けようと思って、前回やった主成分分析をやってみる。
（実はとある人にこのアニメを勧めたはいいが、自分はまったく知らないのでキャラを覚える意味でやるという…）
data0 <- read.csv("loverive.txt", header=TRUE) data1 <- data0[,-which(colnames(data0)=="name")] #PCA用に数値だけにする
B W H height age name 1 90 60 82 156 17 東條 希 2 88 60 84 162 17 絢瀬 絵里 3 82 60 83 156 15 小泉 花陽 4 80 58 80 159 16 南 ことり 5 78 56 83 161 15 西木野 真姫 6 78 58 82 157 16 高坂 穂乃果 7 76 58 80 159 16 園田 海未 8 75 59 80 155 15 星空 凛 9 74 57 79 154 17 矢澤 にこ
plot(data1, cex=1)
cors <- cor(data1) library(gplots) colors <- greenred(20) image(seq(nrow(cors)), seq(ncol(cors)), cors, xlab="", ylab="", axes=FALSE, col=colors, zlim=c(-1, 1)) axis(1, at=seq(nrow(cors)), label=rownames(cors), las=2) axis(2, at=seq(ncol(cors)), label=rownames(cors), las=2)
B W H height age B 1.000 0.696 0.672 0.319 0.436 W 0.696 1.000 0.364 -0.118 0.203 H 0.672 0.364 1.000 0.560 -0.083 height 0.319 -0.118 0.560 1.000 0.000 age 0.436 0.203 -0.083 0.000 1.000
respca <- prcomp(data0[, -which(colnames(data0)=="name")], scale=TRUE) respca$rotation cols <- c("black", topo.colors(ncol(data0[, -which(colnames(data0)=="name")]) - 2), "red") barplot(t(respca$rotation[, 1:2]), beside=TRUE, las=1, col=1:2, ylim=c(-1, 1))
summary(prcomp(data0[, -which(colnames(data0)=="name")]))
Importance of components: PC1 PC2 PC3 PC4 PC5 Standard deviation 5.9287 2.7019 1.20465 0.85421 0.53456 Proportion of Variance 0.7825 0.1625 0.03231 0.01625 0.00636 Cumulative Proportion 0.7825 0.9451 0.97739 0.99364 1.00000
第2主成分までで95%近く説明できるようだ。
pca_score <- scale(data1) %*% eigen(cor(data1))$vectors *sqrt(nrow(data1)/(nrow(data1) - 1)) plot(pca_score[, 1:2], type="n", xlab="PC1", ylab="PC2", xlim=c(-1, 1)*4, ylim=c(-1, 1)*4) text(pca_score[,1:2], as.character(data0$name))
第1主成分は、スリーサイズに対する影響が一目瞭然だろう。
絢瀬絵里と東條希が負に突出、矢澤にこが正に突出している点からもそうだろう。
第2主成分はちょっとよくわからないが、東條希と矢澤にこが高学年の割に背が小さい。一方で、西木野真姫は最年少ではあるが、背は大きい方だ。
ということで、年下のくせに大きな娘か、年上のくせに小さい、みたいな?
ちなみにこれは性格を一切反映していないので実際のところよくわからない。
ここで、せっかく彼女らのイラストがあるのだから、Rのプロット上に写真を出したくなった。
ちょっと前にbiOpsというパッケージを聞いたのでやってみたが、プロットした点に対応して画像を貼り付ける、というのがうまくいかない。
というのでこんな感じにした。
画像を貼り付ける座標を四方四ヶ所指定すればいい感じにプロットしたように見える。
pngでしかうまくいかなかった。jpgは違う方式でデータ格納されているのでやる気があればやる。
これもうまくいかなかった。
#上の画像をpng保存してちまちまやる。 library(png) picnames <- c("tojo", "ayase", "koizumi", "minami", "nishikino", "kosaka", "sonoda", "hoshizora", "yazawa") pics <- vector("list", length(picnames)) for(i in seq(picnames)){ pics[[i]] <- readPNG(paste("path", picnames[i], ".png", sep="")) } ra <- 1 #原点に近いところが潰れるので拡大したかったけど、等倍でやった。 xyl<- 4 #プロット領域 xy0 <- sapply(pics, dim)[1:2, ] #pixel rownames(xy0) <- c("height", "width") s0 <- 0.01 #拡大縮小率 plot(pca_score[, 1:2], type="n", xlim=c(-1, 1)*xyl, ylim=c(-1, 1)*xyl, xlab="←グラマラス ロリ→", ylab="←大きい妹キャラ 小さなお姉さんキャラ→") title("身体的特徴プロフィールを用いた主成分分析") for(j in seq(pics)){ rasterImage(image=pics[[j]], xleft=pca_score[j, 1]*ra - xy0[2, j]/2*s0, ybottom=pca_score[j, 2]*ra - xy0[1, j]/2*s0, xright=pca_score[j, 1]*ra + xy0[2, j]/2*s0, ytop=pca_score[j, 2]*ra + xy0[1, j]/2*s0) }
南ことりが下敷きになってしまったがしょうがない…
ことり厨が発狂しないようにことりが前面バージョンも作った。
今回は9人だけだったが、もっと人数の多いTHE IDOLM@STER (HP)や、もっともっと人の多いTHE IDOLM@STER CINDERELLA GIRLS (HP)もあるので、データベースがあればやってみないこともない…
