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

モデル1

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

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

#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)に以下のような線形の式を置く。

#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)")

モデル1

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

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)