インターネット利用者数のデータにバスモデルを当てはめてみた

バスモデルのなんたるかについては バスモデル - ORWikiを参照。

とりあえず閉じた形で解が求まるらしい。

deSolve パッケージを使って数値的に解いた値と解析解をくらべて、この解が正しいことを一応確かめた。

丸が数値解、曲線が解析解。

#Rのコード
Bass <-function(t,m,a,b,c){
  m*(1-c*exp(-(a+b)*t))/((b/a)*c*exp(-(a+b)*t)+1)}library(deSolve)
deBass <-function(Time, State, Pars){
  with(as.list(c(State, Pars)),{
    dx =(a+(b/m)*x)*(m-x)return(list(c(dx)))})}
ini  <- c(x =0)
times <- seq(0,100,by=1)
pars  <- c(a=0.05,b=0.01,m=1000)
out1   <- ode(ini,times, deBass, pars)
curve(Bass(x,1000,0.05,0.01,1),0,100)
points(out1)

続いて minpack.lm パッケージの nls.lm 関数をインターネット利用者数のデータに（総務省｜平成25年版 情報通信白書｜インターネットの利用状況）バスモデルとロジスティック曲線をそれぞれ当てはめてみた。

library(minpack.lm)
x <- c(6942,7730,7948,8529,8754,8811,9091,9408,9462,9610,9652)
tim <-1:length(x)
logis <-function(x,a,b,c){
  a/(b+exp(-c*x))}
fit_logis <-nls.lm(par=c(10000,0.2,0.3),fn=function(pars)x-logis(tim,pars[1],pars[2],pars[3]),
                  control =list(maxiter =100))
fit_bass <-nls.lm(par=c(10000,0.2,0.3,1),
                  fn=function(pars)x-Bass(tim,pars[1],pars[2],pars[3],pars[4]),
                  control =list(maxiter =100))
plot(x,main="logistic vs Bass model")
curve(logis(x,coef(fit_logis)[1],coef(fit_logis)[2],coef(fit_logis)[3]), add=TRUE,col="tomato",lwd=2)
curve(Bass(x,coef(fit_bass)[1],coef(fit_bass)[2],coef(fit_bass)[3],coef(fit_bass)[4]),add=TRUE,col="royalblue",lwd=2)
legend("bottomright",c("logistic","Bass"),lwd=2,lty=1,col=c("tomato","royalblue"))

残差平方和（だけ）をみると、バスモデルのほうが当てはまりがいい。

> sum(resid(fit_logis)^2)[1]100113.1> sum(resid(fit_bass)^2)[1]77626.51