昔、ラブライブキャラの主成分分析をやって、アニメ初見者のためにキャラを分類してみたのだが、Wake Up, Girls!もラブライブ的な匂いがするのでキャラを覚えるついでにやってみる。
本当は体重推定問題をやりたかったのだが、3サイズが既にあったのでやめた。
やはり身長が高いとスタイルはよくなる。が、今回ウエストは他のパラメータとの相関が弱め。
age height weight B W H age 1 0.88 0.64 0.73 0.3 0.69 height 0.88 1 0.89 0.82 0.5 0.74 weight 0.64 0.89 1 0.8 0.6 0.77 B 0.73 0.82 0.8 1 0.42 0.64 W 0.3 0.5 0.6 0.42 1 0.52 H 0.69 0.74 0.77 0.64 0.52 1
一番ﾛﾘｨな鈴木萌歌と、千早を想起させるような鈴木玲奈のﾋﾝﾇｰがものすごい目印になる。
第二主成分までで86%が説明がつくらしく、軸の説明としてはこんなもんだろう。
# データ name age height weight B W H 島田真夢 15 159 46 75 57 83 林田藍里 15 155 45 77 58 85 片山実波 14 150 40 72 57 84 七瀬佳乃 16 159 44 70 58 82 久海菜々美 13 148 39 74 50 79 菊間夏夜 18 164 50 85 59 83 岡本未夕 17 162 48 80 60 86 岩崎志保 17 163 45 82 55 81 近藤麻衣 20 168 48 85 58 88 吉川愛 16 155 40 74 56 80 相沢菜野花 19 160 42 80 58 84 鈴木萌歌 13 146 35 69 55 75 鈴木玲奈 20 162 44 78 52 85 小早川ティナ 18 165 49 88 60 86
dat <- read.delim("clipboard") dat1 <- dat[, -1] plot(dat1) pr1 <- prcomp(dat1, scale.=TRUE) summary(pr1) pngs <- list.files("/wug/") library(png) # 適当なところから png を取ってきておく。 pics <- vector("list", length(pngs)) for(i in seq(pics)){ pics[[i]] <- readPNG(paste("/wug/", pngs[i], sep=""), native=TRUE) } ra <- 1 #原点に近いところが潰れるので拡大したかったけど、等倍でやった。 xy0 <- sapply(pics, dim)[1:2, ] #pixel xy0[2,] <- 100 # なんか横が潰れるのでテコ入れ rownames(xy0) <- c("height", "width") s0 <- 0.008 #拡大縮小率 bityosei <- replicate(14, c(0.5,-2.8)) bityosei[2, c(2,3,7,14)] <- 3.8 bityosei[1, 4] <- 0.05 par(mar=c(5, 4.5, 4, 2)) plot(pca_score[, 1:2], type="n", xlab="← 大人\tスタイル\tロリ →", ylab="← グラマー 年相応スタイル スレンダー →", xlim=c(-3.5, 4.5), ylim=c(-1.5, 2.5), cex.lab=2) title("Wake Up, Girls! のキャラ分析", cex.main=2) abline(h=0, v=0, lty=3, col=grey(0.7)) lay0 <- pca_score[,1:2] lay0[4, 1] <- lay0[4, 1] + 0.18 # 七瀬佳乃の微調整 for(i in rev(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) text(pca_score[i, 1], pca_score[i, 2], as.character(dat$name)[i], adj=bityosei[,i]) }
