声優統計第一号で、アニメの内容及びキャスティングを用いないDVD売上予測問題というのをやっていたのだが、円盤売上と声優出演データが取れたらやってみたいと思っていたところ、声優さん共演関係など解析という記事を見つけたのでやってみる。
声優統計第一号では、声優の出演情報を直接用いず、出演人数や制作会社、楽曲提供者や原作力といったメタ情報からの推定を行なっていたが、今回は声優を直接解析して大人の事情を完全無視した。
データは円盤売上と、各アニメに声優が出演しているか否かの0/1行列である。データベースをクロールしたが、出演が一回でもあれば出演としているので、主役とモブの区別がされていない。ということもあって、チョイ役での出演が多くて残念な推定結果になってしまった声優がちらほらいるので、出演回数による重み付けなんかをしてどうにかしたい。
結論としては、東山奈央、花澤香菜をヒロインに据えて萌豚を取り込み、宮野真守、神谷浩史、小野大輔を起用して腐女子を取り込み、若本規夫と中田譲治を起用してぶるぁぁぁぁぁすれば売れるかも知れない…
モデルは解釈しやすいように、多重線形回帰にした(正則化とかもう面倒だった)。ある声優について、
とする。ここで、あるアニメの円盤売上
について、
というモデルを考える。ここで、が円盤売上貢献度になる。帰無仮説
について棄却されれば、この
は0ではなさそう、となり、貢献する(負ならしないことになるけど)かどうかがわかる。今回は声優が多すぎたので有意水準を0.01にした。
ロバスト推定したらどうなんだろう、というアドバイスを受けたのだが、robustbaseを使ってみるとむしろグダッたので、今回は深追いしない。
アニメ作品で878の円盤売上が取得できたのでヒストグラムを見てみるわけだが、いわゆる覇権アニメというものの影響をものすごく受けやすいので、先の解析でも10000以上の作品は一律10000枚にしている。今回は95%の作品が20000枚以下だったので、20000枚以上の作品は20000枚にした。というのも、補正せずに解析したところ、加藤英美里や斎藤千和といったまどまぎ、化物語声優が過大評価気味になってしまったので、そうした。制作会社も考慮しなくてはならない要因のひとつであることがわかる。
今回抽出した声優は2362人と、作品数に比べて多すぎるので、とりあえず出演作品数が少ない声優は除外した。その後、パラメータが多すぎても過剰適合になるだけなので、ステップワイズでゴリ押ししたところ、155人にまで絞られた。
本来ならこのモデルで交差検証して、その後独立したデータセットで売上推定をしてモデルの妥当性を検証したいが、時間がないので略。
売上貢献度のパラメータ
estimate 0.5 % 99.5 % (Intercept) 2830 2222 3437 うえだゆうじ 2038 336 3739 伊丸岡篤 2878 579 5177 井上和彦 2601 640 4561 遠藤大智 2684 26 5342 花澤香菜 1865 551 3178 皆川純子 2861 1003 4719 宮野真守 2018 251 3785 恒松あゆみ 2832 184 5481 高橋研二 3979 1374 6583 根谷美智子 2307 507 4106 若本規夫 3263 1238 5287 小形満 3404 326 6481 小野大輔 1560 142 2978 神谷浩史 3841 2343 5339 神田朱未 2288 186 4389 神奈延年 2841 110 5572 青野武 3861 890 6833 川原慶久 2546 634 4457 大川透 2910 1317 4503 大塚明夫 3867 1407 6327 中井和哉 2091 133 4049 中村知子 3986 1103 6868 中田譲治 1914 291 3537 仲野裕 4332 1514 7151 東山奈央 4216 1665 6767 二又一成 3144 66 6222 門脇舞以 2019 102 3936 野川さくら 2840 559 5120
(お、おい!!この結果からいくと魔法戦争の売上がﾊﾟﾈｪことになんぞ!!)
というわけで、2014冬アニメを予測すると、東山奈央、宮野真守、花澤香菜が出る作品がよく売れそうな雰囲気がする。
未確認で進行形の売上予測がひどいことになっているが、これは主役を演じているキャラの中の人の出演作品が少ないため、モデルに使われなかったせいで、ほとんどが白夜の中の人の影響を受けている。
2014冬アニメ 予測売上 いなり、こんこん、恋いろは。 -4009 マケン姫っ！通 -494 ウィザード・バリスターズ〜弁魔士セシル 6081 ニセコイ 7356 世界征服〜謀略のズヴィズダー〜 6444 Wake Up, Girls！ 2112 のうりん 4455 桜Trick 565 未確認で進行形 -1206 鬼灯の冷徹 -3611 魔法戦争 7514 Z/X IGNITION 4061 pupa 4384 銀の匙 Silver Spoon 第2期 5049 GO！GO！575 4580 ストレンジ・プラス -1143 中二病でも恋がしたい！戀 5158 お姉ちゃんが来た -3529 妖怪ウォッチ 1631 ハマトラ THE ANIMATION 3262 ディーふらぐ！ 7137 そにアニ -SUPER SONICO THE ANIMATION- 432 とある飛空士への恋歌 1713 おにくだいすき！ゼウシくん 4694 ノブナガ・ザ・フール 15174 みんな集まれ！ファルコム学園 4888 となりの関くん 3578 バディ・コンプレックス 2764 咲-Saki- 全国編 14900 スペース☆ダンディ 2830 ウィッチクラフトワークス 2907 ノブナガン 5805 最近、妹のようすがちょっとおかしいんだが。 2830 生徒会役員共＊ 6205 プピポー！ -341
売上の補正(>20000)を行わないものもやってみたが、+5000枚以上とかものすごい貢献度になる声優が減ったので、まあそれなりに補正した意味はあったと思う。
え?逆に、売れない声優は誰かって?そんなん書いたら炎上するだろう…
dat <- read.delim("result.txt") idx <- apply(!apply(dat[,c(2,4)], 1, is.na), 2, any) & !is.na(dat$CV) # 欠損していないデータだけ取り出す dat <- dat[idx,] cv <- lapply(strsplit(as.character(dat$CV), " "), unique) # 出演声優 uriage <- mapply(function(y) dat[y, ifelse(is.na(dat$sum[y]), 4, 2)], seq(nrow(dat))) # 円盤売上 uriage[uriage > 20000] <- 20000 # 円盤売上を補正する # 円盤売上のヒストグラム par(mar=c(5,5,4,2)) hist(uriage, nclass=200, xlab="円盤売上枚数", ylab="作品数", main="円盤売上", cex.lab=2, cex.main=2) legend("topright", legend=paste("中央値", median(uriage)), bty="n", cex=2) quantile(uriage, 0.95) # 上位 95%の作品の円盤売上枚数 library(arules) # 共起を行列形式に変換する tr <- as(cv, "transactions") mat <- as(tr, "matrix") n <- 14 # 出演本数が少ない声優は除外する mat0 <- as.data.frame(cbind(uriage, mat[, colSums(mat) > n])) # ステップワイズで変数選択を行う # くっそ時間がかかる g0 <- step(lm(uriage ~ ., data=mat0)) alpha <- 0.99 # 有意水準 conf1 <- confint(g0, level=alpha) # 信頼区間の算出 # 実際の値とモデルによる予測値の誤差を考える pr1 <- cbind(uriage, predict(g0, mat0[,-1])) # 実際の売上とモデルによる予測売上 R2 <- cor(pr1[,1], pr1[,2])^2 # R^2 値 xl <- yl <- range(pr1) par(mar=c(5, 5, 2, 2)) plot(pr1, xlab="実際の円盤売上", ylab="予測円盤売上", xlim=xl, ylim=yl, cex=1, pch=16, cex.lab=2) abline(h=0, v=0, lty=3) legend("topright", legend=substitute(R^2==x, list(x=round(R2, 3))), bty="n", cex=2) # 売上に貢献する声優 p.values <- summary(g0)$coefficients[,"Pr(>|t|)"] # パラメータのp値 idx <- order(g0$coefficients) # 点推定が小さい順に並べる cols <- ifelse(p.values[idx] < 1-alpha, 2, 1) # 有意水準を下回るパラメータのみ色付け par(mar=c(3, 5, 2, 2)) matplot(conf1, type="n", xlab="", ylab=paste("円盤売上寄与 (", round(alpha*100), "%CI)", sep=""), cex.lab=2, xaxt="n") mtext("← 売れない声優\t売れる声優 →", side=1, cex=2, line=1.5) points(g0$coefficients[idx], pch=16, cex=0.5, col=cols) segments(seq(nrow(conf1)), conf1[idx, 1], y1=conf1[idx, 2], col=cols) abline(h=0, lty=3) title(paste(nrow(mat0), "作品,", nrow(conf1), "声優の円盤売上寄与解析"), cex.main=2) # 有意な声優 # 不等号の向きを変えれば… idx <- p.values < 1-alpha & conf1[,1] > 0 round(cbind(g0$coefficients, conf1)[idx,])
