声優統計の統計C91版

MikuHatsune2016-12-30

声優統計第九号は、新刊の第九号と既刊の5-8 がまとまった論文集2 ともに完売しました。

 
そして、本当に最後らしいです。
告知から最後、と言っていて、自分も原稿中に「最後の…」とか書いてて、コピー本印刷を見に行った時に完成サンプルをみても他執筆陣が「最後の…」とか書いてたので、壮大なドッキリが待ち構えていると思っていたのですが、ここまでくると本当に最後のようです。
最後に怒涛の自己引用をしたので、インパクトファクターは少し持ち直して、0.18 となりました。

 
まんがタイムきららフェスタ2016 の観客動員力の推定というものをrstan でやりました。条件式からしてスッカスカだったので推定結果は本当にこんなんでいいの? 感が満載です。
 
出演パターン

 
推定結果

 
出演情報

anime	bd	茅野愛衣	M・A・O	水瀬いのり	高橋李衣	小澤亜季	種田梨紗	内山夕実	田中真奈美	東山奈央	西明日香	和久井優	金澤まい	今村彩夏	戸田めぐみ	山口愛	高田憂希	竹尾歩美	花守ゆみり	白石晴香	安野希世乃	山村響	吉岡茉祐	長縄まりあ	前川涼子	大久保瑠美	内田真礼
がっこうぐらし	2426	1	1	1	1	1	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0
きんいろモザイク	6582	0	0	0	0	0	1	1	1	1	1	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0
三者三葉	2269	0	1	0	0	0	0	0	0	0	1	1	1	1	0	0	0	0	0	0	0	0	0	0	0	0	0
NEWGAME	6452	1	0	0	0	0	0	0	0	0	0	0	0	0	1	1	1	1	0	0	0	0	0	0	0	0	0
あんハピ	1197	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	1	1	1	1	1	0	0	0	0
ステラのまほう	1000	0	0	0	0	1	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	1	1	0	0
ご注文はうさぎですか?	11038	1	0	1	0	0	1	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	1
ゆゆ式	3082	1	0	0	0	0	1	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	1	0
# model01.stan
data{
  int<lower=0> N;
  int<lower=0> M;
  int<lower=0, upper=1> castN[N, M];
  int<lower=0> BD[M];
}
parameters{
  real<lower=0> theta[N];
  #real<lower=0> s[M];
}
transformed parameters{
  real<lower=0> alpha[M];
  for(j in 1:M)
    alpha[j]  <- 0;

  for(i in 1:N)
    for(j in 1:M)
      alpha[j] <- alpha[j] + theta[i]*castN[i, j];
}


model{
  BD ~ poisson(alpha);
}
library(rstan)
library(vioplot)
d <- read.delim("kirara.txt", stringsAsFactors=FALSE, row=1, check.names=FALSE)
bd <- d$bd
dat <- subset(d, select=-bd)
festa <- 5000

dat <- rbind.data.frame(dat, "きららフェスタ"=rep(1, ncol(dat)))
bd <- c(bd, festa)

bvec <- rep(1, ncol(dat))
const.dir <- rep("==", nrow(dat))
solveLP(bvec, bd, dat, maximum=TRUE, const.dir)



N <- ncol(dat)
M <- nrow(dat)
castN <- unlist(dat[1,])
castN <- t(as.matrix(dat))
BD <- bd
stan_data <- list(N=N, M=M, castN=castN, BD=BD)


model <- stan_model("model01.stan")
fit <- sampling(model, stan_data, chain=3, warmup=1000, iter=2000)
ex <- extract(fit)
theta <- apply(ex$theta, 2, median)
names(theta) <- colnames(dat)
alpha <- apply(ex$alpha, 2, median)

rowSums(sweep(dat, 2, theta, "*"))




d <- t(dat)
colcex <- replace(rep(1, ncol(d)), 7, 0.8)

# 出演パターン
par(mar=c(6, 8, 1.5, 3))
image(seq(nrow(d)), seq(ncol(d)), d, xaxt="n", yaxt="n", col=c(0, 1), xlab="", ylab="")
text(par()$usr[1]-8.5, seq(ncol(d)), colnames(d), xpd=TRUE, pos=4, cex=colcex)
text(par()$usr[2], seq(ncol(d)+1), c(bd, "売上"), xpd=TRUE, pos=4)
tate <-  mapply(function(z) paste0(strsplit(z, "")[[1]], collapse="\n"), rownames(d))
ad <- nchar(rownames(d))-min(nchar(rownames(d)))
ady <- 0.2
text(seq(nrow(d)), par()$usr[3]-0.3-ad*ady, tate, xpd=TRUE, pos=1)
abline(v=head(seq(nrow(d)), -1)+0.5, h=head(seq(ncol(d)), -1)+0.5, lty=3)

# 推定結果の可視化
par(mar=c(5, 5.2, 2, 3.2), cex.lab=1.5)
plot(0, xlim=c(0, max(ex$theta)), ylim=c(1, ncol(dat)), type="n", yaxt="n", xlab="観客動員数の推定値", ylab="")
abline(h=seq(ncol(dat)), lty=3, col=grey(0.2))

text(par()$usr[2], seq(ncol(dat)+1), c(round(apply(ex$theta, 2, median)), "最頻値"), pos=4, xpd=TRUE)
text(par()$usr[1]-3500, seq(ncol(dat)), colnames(dat), pos=4, xpd=TRUE)
eval(parse(text=paste0("vioplot(", paste0(paste0("ex$theta[,", seq(ncol(dat)), "]"), collapse=","), ",horizontal=TRUE,names=rownames(d),col=grey(0.8),border=NA,add=TRUE,colMed='black')")))
title	author	publish	C84	C85	C86	C87	C88	C89	C90	C91
日本声優統計学会発足のご挨拶 -声優と科学の融合を目指して	@MagnesiumRibbon	83	0	0	0	1	1	1	0	0
Wikipediaの声優PVデータ特性とブレイク判定手法	@kkobayashi	83	2	0	1	0	1	0	0	0
キャスティング情報のbag-of-声優モデルを用いた音響監督推定問題	@MagnesiumRibbon	83	1	1	1	0	0	1	0	0
声優統計入門	@R_Linux	83	0	0	0	0	0	0	0	0
ブログを用いた女性声優の結婚時期予測問題	@y_benjo	83	0	0	0	1	0	1	0	1
アニメの内容及びキャスティングを用いないDVD売上予測問題	@y_benjo	83	1	0	1	0	0	0	0	1
序文 「日本声優統計学会に寄せて」	@toddler2009	84	0	0	0	0	0	0	0	0
トピックモデルを用いたニコニコ動画コメントデータの声優トピック流行推移解析	@Med_KU	84	0	0	0	1	0	0	0	0
声優活動における「元アイドル」の影響予測	@kkobayashi	84	0	0	0	0	1	0	0	0
声優ブログの「ご報告」エントリ自動検出システムの検討	@MagnesiumRibbon	84	0	0	0	1	0	0	0	0
続・声優統計入門 貧乳と巨乳の狭間で	@R_Linux	84	0	0	0	0	0	0	0	0
音声による既婚声優の判別問題	@y_benjo	84	0	1	0	0	1	1	1	1
Labeled LDAを用いた声優のニコニコ動画における特徴的コメントの抽出	@y_benjo	84	0	0	0	1	0	0	0	0
序文: 声優統計における言語情報と非言語情報 -- 『声優統計』第三号に寄せて --	@langstat	85	0	0	0	0	0	0	0	0
声優も「箱で推せ!」 -- 声優ファンにおける推し声優コミュニティの検出 --	@kkobayashi	85	0	0	0	0	0	0	0	0
ソーシャルな声優イベント参加履歴に基づく声優ファン行動の定量化分析	@MagnesiumRibbon	85	0	0	0	2	0	0	0	1
アニメ,声優,二次創作における百合ネットワークの考察	@Med_KU	85	0	0	0	0	0	0	0	1
複数の声優によるセリフの音響的類似性の考察:不愉快です	@Med_KU	85	0	0	0	0	0	0	0	0
続・続・声優統計入門 -- 初めてのテキストマイニング --	@R_Linux	85	0	0	0	0	0	0	0	0
今会いに行ける声優: ブログに登場する位置情報単語を用いた声優の出現位置予測	@y_benjo	85	0	0	1	1	0	0	0	0
声優の結婚時期予測2013: 2012年予測の精度,変化	@y_benjo	85	0	0	0	0	0	1	0	0
Twitterからみる声優ファンのネットワーク構造	@ysks3n	85	0	0	0	0	0	0	0	0
序文: 声優と統計とシンギュラリティ -- 声優統計の目指す未来 --	@MagnesiumRibbon	86	0	0	0	0	0	0	0	0
種田梨沙が出演すると百合アニメか?: Propensity score matching による検討	@Med_KU	86	0	0	0	0	0	0	1	0
声優ファンが今推したいアイドル	@kkobayashi	86	0	0	0	0	0	0	0	0
声優固有のアニメ顔は存在するか: Deep Learning を用いたアニメ画像キャスティング一致問題	@y_benjo	86	0	0	0	0	0	0	0	0
声優統計未解決問題	@y_benjo	86	0	0	0	0	1	0	0	0
田村ゆかりは永遠の 17 歳なのか? - CV から見た声年齢の推移 -	@harapon	87	0	0	0	0	0	0	0	0
現役女子高生声優とその周辺事情	@kkobayashi	87	0	0	0	0	0	0	0	0
晴れ声優もしくは雨声優に対する統計学的考察	@MagnesiumRibbon	87	0	0	0	0	0	0	1	0
Twitterの投稿時間分布から見る声優の生態	@Med_KU	87	0	0	0	0	0	0	0	0
パンツを求めて	@R_Linux	87	0	0	0	0	0	0	0	0
主役力 : キャストの表記順に着目したプレイヤーレーティング	@y_benjo	87	0	0	0	0	0	0	0	0
声優の食事内容の検討 - 外食声優を求めて -	@dichika	87	0	0	0	0	0	0	0	0
序文 : 人工声優は東京ドーム公演の夢を見るか?	@hitoshi_ni	88	0	0	0	0	0	0	0	0
イベント出演状況から予想するネクストブレイク声優	@kkobayashi	88	0	0	0	0	0	1	0	0
同一セリフからの声優と心情の同時推定問題 -- 声優統計標準ベンチマークの提案	@MagnesiumRibbon	88	0	0	0	0	0	0	0	1
ダメ絶対音感:レベル・ネオは早見沙織? 日笠陽子?	@Med_KU	88	0	0	0	0	0	0	0	1
青田買いの神話 : 青田買いを考慮した製品普及モデルにもとづく声優分析	@y_benjo	88	0	0	0	0	0	0	0	0
脇役識別問題	:-)	88	0	0	0	0	0	0	0	0
結婚したら声優は仕事が減るのか?	@Med_KU	89	0	0	0	0	0	0	0	0
日本声優統計学会 投稿&査読ガイド	@MagnesiumRibbon	89	0	0	0	0	0	0	0	0
「他界」の科学 : 限界効用逓減と代替財を考慮した声優イベント参加モデル	@y_benjo	89	0	0	0	0	0	0	0	0
Wikipediaとラジオでの楽曲選択に基づく黒沢ともよさんの音楽嗜好推定	@wakuteka	89	0	0	0	0	0	0	0	1
Bluemix × Watson × 声優	@kkobayashi	89	0	0	0	0	0	0	0	0
なれる!声優〜Deep Learning を利用した声質変換〜	@asteerism	90	0	0	0	0	0	0	0	0
声優しりとり	@Med_KU	90	0	0	0	0	0	0	0	0
複数声優歌唱楽曲における歌唱パート特定問題 ~声優統計的ハイレゾのススメ~	@MagnesiumRibbon	90	0	0	0	0	0	0	0	0
「他界」の科学 (2) : 個別の感染症モデルにもとづくイベント参加予測	@y_benjo	90	0	0	0	0	0	0	0	0
会いにいける賃貸住宅を求めて	@wakuteka	90	0	0	0	0	0	0	0	1
声優統計特別研究員	@Med_KU	91	0	0	0	0	0	0	0	0
まんがタイムきららフェスタ2016	@Med_KU	91	0	0	0	0	0	0	0	0
声優力	@Med_KU	91	0	0	0	0	0	0	0	1
前書き	@R_Linux	91	0	0	0	0	0	0	0	0
seiyu2vec	@MagnesiumRibbon	91	0	0	0	0	0	0	0	0
二次配布可能な音素バランス文と声優統計音声コーパスの構築	@y_benjo	91	0	0	0	0	0	0	0	0
テレビアニメにおける新人声優とその傾向について	@kkobayashi	91	0	0	0	0	0	0	0	0
黒沢ともよさんの音楽嗜好に基づくロックフェス推薦システムに関する取り組み	@wakuteka	91	0	0	0	0	0	0	0	0