Bass模型遗传算法的R实现

Question

我尝试估计低音曲线以分析不同群体的创新扩散。到目前为止，我使用nlsLM()该minpack.lm包来估计曲线的参数/以拟合曲线。我遍历不同的起始值以使用此命令为不同的起始值估计最佳拟合：

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 和 Kumar (2002)建议在数据稀缺时使用遗传算法方法进行低音模型估计（另见Venkatesan 等人 2004）。我发现了一些在 R 中实现 GA 的包（如GA, genalg, gafit）。但是，由于我是该领域的新手，我不知道该使用哪个包以及如何使用包中的低音公式。

• 对于这种估计，您是否会推荐一个软件包？
• 如果是，是否有示例说明如何在包的代码中包含低音模型的公式？

Answer 1

我希望下面的代码可以帮助你。我使用“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)