Bass模型遗传算法的R实现

R implementation of Genetic Algorithm for Bass Model

我尝试估计 Bass 曲线来分析不同群体的创新扩散。到目前为止,我使用 minpack.lm 包的 nlsLM() 来估计 curve/to 拟合曲线的参数。我循环遍历不同的起始值以使用此命令针对不同的起始值估计最佳拟合:

Bass.nls <- nlsLM(cumulative_y~ M * (((P + Q)^2/P) * exp(-(P + Q) * time))/(1 + (Q/P) * exp(-(P + Q) * time))^2
                , start = list(M=m_start, P= p_start, Q=q_start)
                , trace = F
                , control = list(maxiter = 100, warnOnly = T) )

由于某些组的数据点很少,因此许多组不会收敛。

Venkatesan and Kumar (2002) suggest to use a Genetic Algorithm approach for bass model estimations when data is scarce (see also Venkatesan et al 2004)。我发现了一些在 R 中实现 GA 的包(比如 GAgenalggafit)。但是,由于我是新手,不知道用哪个包,包里的bass公式怎么用。

希望下面的代码能帮到你。我使用 "GA" 包来利用遗传算法。

x <- c(840,1470,2110,4000,7590,10950,10530,9470,
       7790,5890)

t<- 1:length(x)
Horiz <- length(x)




fit <- function(p,q,m) {

    res = x - (m*((exp((p+q)*t)*p*(p+q)^2) / (p*exp((p+q)*t)+q)^2))

        -(sum(res**2)/Horiz)

}



GA <- ga(type = "real-valued", 
         fitness = function(x) fit(x[1],x[2],x[3]),
         lower = c(0,0,0), upper = c(1,1,sum(x)*2), 
         popSize = 1000, maxiter = 1000 ,run = 500)