乃木坂46は、2012年2月22日に1st single ぐるぐるカーテンを発売し、
2014年4月2日に 8th single 気づいたら片想い を発売した。
このリリースと、
他のグループのリリースを比較すると次図の通りである。特に、NMB48は
乃木坂46より７ヶ月前に1st singleを発行してこれまで９シングルを発売
している。SKE48はより歴史が長いがほぼNMB48と同様の動きである。
AKB48はこれらよりも多いが、「じゃんけん選抜曲」（次図の◇）と、
「総選挙の投票権封入曲」（□）の２つのシングルが特別な意味がある。
前者は売上が落ちることが多く、後者は逆に１８０万枚に達することもある。
それらを除く他とほぼ同じペースの発行である。
plot(-release$days, release$grp, axes = F, xlab = "days before 2014/4/2", ylab = "",
main = "シングル リリース時期 ", xlim = c(-1050, 50), ylim = c(0.7, 5.2))
axis(1, at = -100 * (0:10), 100 * (0:10))
axis(2, at = 1:5, as.character(levels(release$grp)), las = 2)
collist <- c(rep(1, 14), rep(2, 9), rep(3, 9), rep(4, 8), rep(5, 3))
points(-release$days, release$grp, pch = 16, col = collist, cex = 2)
nogi <- c(1, 5, 10, 14, 15, 20, 23, 24, 27, 32, 33, 37, 40, 41, 43)
text(-release$days[nogi], release$grp[nogi], release$kyoku[nogi], pos = 1)
text(-release$days[nogi], release$grp[nogi], release$ngp[nogi], pos = 3)
asel <- c(3, 5, 8, 10, 13)
apch <- c(5, 22, 5, 22, 5)
points(-release$days[asel], release$grp[asel], pch = apch, cex = 2.1, col = 2,
lwd = 2)
mtext("AKB/2(売上の1/2) ◇ じゃんけん選抜曲、□ 総選挙投票券封入曲", side = 1,
line = 2)
各グループのシングル初週売上の推移をみると、次図の通りである。
AKB48については、売上の1/2を表示する。従って50万枚の点線は
AKB48に関しては100万枚である。
乃木坂46のシングル初週売上は、常に前作を上回っている。HKT48も
これまで３作ではあるが右上がりである。
そして、乃木坂46の直近３作は、回帰するまでもなくほぼ直線上で
推移している。それを延長すれば、回帰直線は9thにおいて50万枚を
越えることがわかる。念のため、信頼度90%の回帰直線信頼区間も
表示したが、その範囲は50万枚を超えている。
次作で初週売上50万枚超えは十分可能性があるといえるであろう。
なお、8作全体の傾向は二次近似が適切でありより勢いのある曲線となる。
グラフを４通り提示する。matplot, linesを重ねる、ggplot2, latticeである。
nogi.short <- cbind.data.frame(mai = maisu[7:9, 4], th = 7:9)
nogi.lm <- lm(mai ~ th, nogi.short)
matplot(maisu, type = "o", lwd = 2, lty = c(2, 3, 4, 1, 5), pch = 19, xlim = c(1,
10), xaxt = "n", yaxt = "n", ylim = c(50000, 680000), main = "乃木坂46, SKE48, NMB48, HKT48 シングル曲初週売上 (万枚)",
ylab = "")
axis(1, at = 2:10, c("1st", "2nd", "3rd", paste(4:9, "th", sep = "")))
axis(2, at = 1e+05 * (1:7), 10 * (1:7), las = 2)
abline(v = 10, h = 5e+05, lty = 3)
abline(nogi.lm, lty = 2, lwd = 1.5, col = 4)
new <- data.frame(th = seq(7, 10, by = 0.1))
nogi.pred <- predict(nogi.lm, new, interval = "confidence", level = 0.9)
matlines(new, nogi.pred[, -1], lty = 3, lwd = 1.5, col = 4)
legend("bottomright", c(colnames(maisu), "直近3回帰"), text.col = c(1:5, 4),
ncol = 3, lty = c(2, 3, 4, 1, 5, 2), col = c(1:5, 4), lwd = 2)
mtext("AKB/2(売上の1/2) は「じゃんけん選抜曲」と「総選挙投票権封入曲」を除いている",
side = 1, line = 2)
summary(nogi.lm)
##
## Call:
## lm(formula = mai ~ th, data = nogi.short)
##
## Residuals:
## 1 2 3
## 787 -1574 787
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -86095 10959 -7.86 0.081 .
## th 60350 1363 44.28 0.014 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1930 on 1 degrees of freedom
## Multiple R-squared: 0.999, Adjusted R-squared: 0.999
## F-statistic: 1.96e+03 on 1 and 1 DF, p-value: 0.0144
cnt = 0
ncol = c(1, 5, 3, 2, 4)
nlty = c(2, 5, 4, 3, 1)
plot(release[, 1], release[, 4], type = "n", xlim = c(1000, 0), ylim = c(110000,
890000), main = "時期に合わせた初週売上推移", xlab = "days before 2014/4/2",
ylab = "万枚", yaxt = "n")
axis(2, at = 1e+05 * (1:9), 10 * (1:9), las = 2)
abline(h = 5e+05, lty = 3)
for (cat in levels(release$grp)) {
cnt <- cnt + 1
temp <- release[release$grp == cat, ]
lines(temp[, 1], temp[, 4], type = "o", lwd = 2, col = ncol[cnt], pch = 19,
lty = nlty[cnt])
}
asel <- c(3, 5, 8, 10, 13)
apch <- c(5, 22, 5, 22, 5)
points(release$days[asel], release$mai[asel], pch = apch, cex = 2.1, col = 2,
lwd = 2)
legend("bottomright", levels(release$grp), text.col = ncol, ncol = 3, lty = nlty,
col = ncol, lwd = 3)
優れたグラフを作ることができる。但し、多少の慣れを必要とする。
require(ggplot2)
.plot <- ggplot(data = release, aes(x = (-1) * days, y = mai, colour = grp,
shape = grp)) + geom_point(size = 4) + geom_line(size = 1.1) + xlab("days before 2014/4/2") +
ylab("初週売上") + labs(colour = "grp", shape = "grp") + theme_bw(base_size = 16,
base_family = "serif") + theme(legend.position = "top")
# scale_colour_brewer(palette = 'Set1') + scale_y_continuous(expand =
# c(0.01, 0)) +
print(.plot)
lattice による命令は下記のように簡単であり、かつ線種とシンボルも自動的に選択され、わかりやすいグラフができる。ただし、R Markdown を knitr で処理すると、線種・シンボルともに均一となってしまうので、現状では使いにくい。
require(lattice)
xyplot(mai ~ -days, groups = grp, data = release, type = "b", lwd = 2, auto.key = list(columns = 5),
cex = 1.5)
