廿TT

譬如水怙牛過窓櫺 頭角四蹄都過了 因甚麼尾巴過不得

Nerlove-Arrow の広告−販売モデル

モデル

Nerlove と Arrow(読み方はネルロフとアロウでいいのかな?)が提案したらしい広告に対する市場の販売のモデルというのがあり、これは以下の通り教科書に出てくる「一階線形常微分方程式」そのものの形をしている。

\displaystyle \frac{dA(t)}{dt} = bq(t)-kA(t)

  • A(t) が時刻 t での売上
  • q(t) が広告費用

を表しており、売上の増加は広告費用に比例し、いっぽうで売上は定常的に減少する、というシンプルな仮定を置いている。

解き方

一階線形常微分方程式の公式を覚えるのはたいへんで、解きかたをおぼえたほうが楽な気がする。

\displaystyle \frac{dA(t)}{dt} + kA(t)= bq(t)

を解くには  e^{kt} を両辺にかけてやる。

\displaystyle e^{kt}\frac{dA(t)}{dt} + ke^{kt}A(t)= e^{kt} bq(t)

そうすると積の微分の公式より、

\displaystyle \frac{d}{dt} \{ e^{kt} A(t) \}= e^{kt} bq(t)

となるので、辺々積分して、

\displaystyle  e^{kt} A(t) = b \left\{ \int e^{kt} q(t) dt \right\}

結果、

\displaystyle  A(t) = e^{-kt} b \left\{ \int e^{kt} q(t) dt \right\}

典型的な解の例

最初は製品のことをだれもしらないので、売上 A(t) の初期値は 0 とする。

モデル1

製品のリリース後しばらく(時刻 τ まで)は同じだけの広告費用をかけ、しばらくしたら(時刻 τ 以降)広告を打ち切るような場合 を考え、q(t) を以下のようにする。

\displaystyle q(t)= \begin{cases}
\displaystyle q_0 & t < \tau\\
\displaystyle 0 & t \ge \tau\\
\end{cases}

A(t) は以下のようになる。

 A(t)= \begin{cases}
\displaystyle \frac{bq_0}{k}(1-e^{-kt}) & t < \tau\\
\displaystyle \frac{bq_0}{k}(e^{kt}-1)e^{-kt} & t \ge \tau \\
\end{cases}

f:id:abrahamcow:20151219010334p:plain

#R のコード
NAmodel0_ex <- function(t,b,k,tau){
  ifelse(t<=tau,
         b*(1-exp(-k*t))/k,
         b*(exp(k*tau)-1)*exp(-k*t)/k
         )
}
par(mfrow=c(2,1))
curve(ifelse(x<10,1,0),0,20,xlab="t",ylab="",main="q(t)")
curve(NAmodel0_ex(x,5*1,0.2,10),0,20,xlab="t",ylab="",main="A(t)")

モデル2

製品のリリース時はいっぱい広告費用をかけるが、直線的に減少していくような場合を考え、q(t) に以下のような線形の式を置く。

\displaystyle q(t)= \begin{cases} 
\displaystyle q_0-\alpha t & t < q_0/\alpha\\
\displaystyle 0 & t \ge q_0/\alpha\\
\end{cases}

\displaystyle A(t)= \begin{cases}
\displaystyle \frac{b(k(q_0-\alpha t))+\alpha}{k^2}-\frac{b(kq_0+\alpha)}{k^2}e^{-kt} & t < q_0/\alpha\\
\displaystyle \left(\frac{b\alpha}{k^2}e^{k q_0/\alpha} - \frac{(kq_0+\alpha)b}{k^2} \right)e^{-kt} & t \ge q_0/\alpha \\
\end{cases}

f:id:abrahamcow:20151219010824p:plain

#R のコード
NAmodel1_ex <- function(t,pars){
  q0 <- pars[1]
  alpha <- pars[2]
  b <- pars[3]
  k <- pars[4]
  ifelse(
    t<q0/alpha,
    b*(k*(q0-alpha*t)+alpha)/(k^2) - (k*q0+alpha)*b*exp(-k*t)/(k^2),
    ((b*alpha)*exp(k*q0/alpha)/(k^2)-(k*q0+alpha)*b/(k^2))*exp(-k*t)
  )
}

curve(ifelse(x<20/0.5,20-0.5*x,0),0,60,xlab="t",ylab="",main="q(t)")
pars  <- c(q0=20,alpha=0.5,b=1,k=1/10)
curve(NAmodel1_ex(x,pars),0,60,xlab="t",ylab="",main="A(t)")

シミュレーション

モデル 2 でパラメータをいろいろ変えてみる。

pars1  <- c(q0=20,alpha=0.5,b=2,k=1/5)
curve(NAmodel1_ex(x,pars1),0,60,xlab="t",ylab="A(t)",lwd=3)
pars2  <- c(q0=20,alpha=0.5,b=1,k=1/10)
curve(NAmodel1_ex(x,pars2),col="red",add=TRUE,lwd=3)
pars3  <- c(q0=20,alpha=0.5,b=1,k=1/5)
curve(NAmodel1_ex(x,pars3),col="blue",add=TRUE,lwd=3)
pars4  <- c(q0=20,alpha=1,b=1,k=1/5)
curve(NAmodel1_ex(x,pars4),col="orange",add=TRUE,lwd=3)

f:id:abrahamcow:20151219011508p:plain

deSolve パッケージで確かめ算

deSolve パッケージで数値的に解いた値と解析解が一致することを確かめる。

曲線が解析解。マルが数値解。

モデル1

f:id:abrahamcow:20151219012321p:plain

library(deSolve)
NAmodel0<- function(Time, State, Pars) {
  with(as.list(c(State, Pars)), {
    q1 <- ifelse(Time < 10, 5, 0)
    dA <- b*q1-k*A
    list(dA)
  })
}
ini  <- c(A = 0)
times <- seq(from=0, to=20,by=0.1)
pars  <- c(b=1,k=0.2)
out <- ode(y=ini,times=times,func = NAmodel0,parms =pars)
curve(NAmodel0_ex(x,5*1,0.2,10),0,20,xlab="t",ylab="",main="A(t)",lwd=2)
points(out)

モデル2

f:id:abrahamcow:20151219012335p:plain

NAmodel1<- function(Time, State, Pars) {
  with(as.list(c(State, Pars)), {
    q1 <- ifelse(Time<q0/alpha,q0-alpha*Time,0)
    dA <- b*q1-k*A
    list(dA)
  })
}
ini  <- c(A = 0)
ts <- seq(from=0, to=60,by=1)
pars  <- c(q0=20,alpha=0.5,b=1,k=1/10)
out <- ode(y=ini,times=ts,func = NAmodel1,parms =pars)
curve(NAmodel1_ex(x,pars),0,60,xlab="t",ylab="",main="A(t)",lwd=2)
points(out)

参考文献

www.math24.net

微分方程式で数学モデルを作ろう

微分方程式で数学モデルを作ろう

関連エントリ

abrahamcow.hatenablog.com