週刊少年ジャンプの掲載順位データという記事を見つけた。そこで、「早いペースで掲載順位が落ちていく漫画は打ち切られそう」という仮説があったので、どのくらいのペースで掲載順位が落ちると打ち切られるのかやってみる。
結果としては4週目以降から打ち切られるものがなんとなく分かれる感じ。
連載開始は宣伝の意味を兼ねて、第1位に掲載されるとして、その後は人気が落ち続けるというモデルを考える。単調減少ならば指数関数モデルを使えるし、ノンパラメトリックならばIsotonic regression (等調回帰とでも訳す)が使える。
打ち切りの定義としては、かなり恣意的ではあるが、半年くらいしか連載できなければ打ち切りとしてみて、24週でとりあえずやってみる。
前のリンクからデータを拝借し、2003年以前に連載されているものと、2015年20号で連載継続しているものを除外し、24週より多く連載している77作品、24週以内に終了した47作品を抽出した。
長期連載する漫画も打ち切られる漫画も、初掲載時から4週までの掲載順位の減少はほぼ同じだが、これ以降から打ち切られる漫画は持ちこたえられなくなる。長期連載する漫画は10週目以降からはほぼ安定した掲載順位、しかもこれは12位程度なので半分より上には掲載されている。打ち切られる漫画はいわゆるドベ3と言われるような20位以下の順位に12週目以降、固定される。
さて、ここでいわゆるエロ枠やラブコメ枠について考える。というのも、いまでは看板枠と言っても(たぶん)過言ではないニセコイだが、この連載が始まった当時は、「パジャマな彼女。」と「恋染紅葉」というラブコメのようなエロ枠のような漫画も連載していた。この3作品について議論するスレもあったようだし、これらの作品のうちどれが生き残ってどれが打ち切られるかが話題になってたし、オレも気になってた。
ここで、エロ枠としていちご100%、To LOVEる、あねどきっ, パジャマな彼女。、 恋染紅葉、E.ROBOT、鏡の国の針栖川、 i.ショウジョが上記のデータに含まれる。ここにニセコイ(連載中なので除外されたいた)を追加する。
これらのデータに対しては、鏡の国の針栖川が残念ながら打ち切り枠に入るように、30週を打ち切りとして再度解析する。
すべての漫画に対して、エロ枠のほうが生き残る場合により早く掲載順位が安定するようである。しかも8位くらいで安定するので、やはりエロ枠は上位に来やすいのだろう。
さて、ここで上で挙げた「パジャマな彼女。」と「恋染紅葉」と「ニセコイ」について個別に検討する。現在も生き残っているニセコイが早々に7位で安定しているのは納得の通りだが、連載が開始となって8週程度まではパジャマな彼女。のほうが上位で安定していた。しかし、これ以降の掲載順位は急転直下となっている。というのも、かの有名なパコろうぜ回がここにあたり、これ以降の掲載順位はまったく盛り返せていない。
オタクは基本的にNTR耐性がないのがほとんどだと考えられるため、こういう展開になるとｳｱｧｧｧｱｱｱﾝﾝﾝってなってそりゃ盛り返せないわな。
個人的にはパジャマな彼女。の作画はレベル高かったし、恋染紅葉もなんだかんだで絵は良かったため、初回からボコデレのゴリラと邂逅→許嫁なんて展開、これなんてエロゲ?というかネタ古臭すぎだろう…で始まったニセコイがここまで続いているのは感無量。
オレも小野寺派かな。
setwd("/jump/") # データのあるディレクトリ files <- list.files(pattern=".csv") dat <- mapply(read.csv, files, row.names=1, stringsAsFactors=FALSE) titles <- unique(unlist(lapply(dat, colnames))) # titles <- c("いちご１００.", "To.LOVEる", "あねどきっ", "パジャマな彼女.", "恋染紅葉", "E.ROBOT", "ニセコイ", "鏡の国の針栖川", "i.ショウジョ") # エロ枠 titles <- titles[-which(titles=="新連載作品.１０週未満.")] titles <- titles[-which(titles=="新連載作品.10週未満.")] idx1 <- colnames(tail(tail(dat, 1)[[1]], 1))[!is.na(tail(tail(dat, 1)[[1]], 1))] idx2 <- colnames(head(head(dat, 1)[[1]], 1))[!is.na(head(head(dat, 1)[[1]], 1))] titles <- titles[-match(union(idx1, idx2), titles)] res <- vector("list", length(titles)) names(res) <- titles for(i in seq(titles)){ for(j in seq(dat)){ if(titles[i] %in% colnames(dat[[j]])){ res[[i]] <- c(res[[i]], dat[[j]][, titles[i]]) } } } res <- mapply(function(x) x[!is.na(x)], lapply(res, as.numeric)) # NA, 休, 落 削除 yl <- c(max(sapply(res, max)), 1) u_wk <- 24 # 打ち切り週 res0 <- list(res[sapply(res, length)<=u_wk], res[sapply(res, length)>u_wk]) wk <- mapply(function(x) mapply(seq, sapply(x, length)), res0) # isotonic regression library(quadprog) vec <- mapply(function(x, y) tapply(unlist(x), unlist(y), median), res0, wk) m <- vector("list", length(vec)) for(i in seq(m)){ Amat <- diag(1, length(vec[[i]])) Amat <- cbind(Amat, Amat[,-ncol(Amat)]+matrix(replace(rep(0, length(Amat[,-ncol(Amat)])), which(c(Amat[,-ncol(Amat)])==1)+1, -1), nrow(Amat))) bvec <- rep(0, ncol(Amat)) Dmat <- diag(1, length(vec[[i]])) dvec <- vec[[i]] m[[i]] <- rev(solve.QP(Dmat, rev(dvec), Amat, bvec=bvec, meq=0)$solution) } x <- lapply(wk, unlist) y <- lapply(res0, unlist) ar <- mapply(function(i, j) drm(j ~ i, fct=AR.3(fixed=c(1, NA, NA))), x, y, SIMPLIFY=FALSE) par(mar=c(4.5, 4.5, 2, 2), mfrow=c(1, 2), cex.lab=1.6) mwk <- 30 # 最大観察週 x0 <- seq(1, max(mwk), length=100) y0 <- sapply(ar, predict, as.data.frame(x0-1)) matplot(x0, y0, type="l", lwd=3, ylim=yl, lty=1, xlab="連載週数", ylab="掲載順位", main="指数関数モデル") legend("topright", legend=paste(u_wk, c("週打ち切り", "週以上連載"), sep=""), lwd=3, col=1:2) abline(v=4, lty=3) plot(seq(mwk), type="n", ylim=yl, xlab="連載週数", ylab="掲載順位", main="等調回帰モデル") for(i in seq(m)) lines(seq(m[[i]]), m[[i]], col=i, lwd=3) legend("topright", legend=paste(u_wk, c("週打ち切り", "週以上連載"), sep=""), lwd=3, col=1:2) abline(v=4, lty=3)
