Bass模型遗传算法的实现

Question

我试图估计Bass曲线来分析不同群体创新的扩散。到目前为止，我使用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)