I am trying to fit two sales diffusion models on sales data of two consecutive product generations. Ultimately, I need to fit the models to determine the optimal launch timing of the second product generation, retrospectively. The models are defined as follows: Models, where F(t) is: F(t), s1 is the sales of the first product generation, s2 is the sales of the second product generation, and Tau2 is the introduction time of the second product generation. M1, M2, q_g and p_q are the parameters that need to be estimated. M1, q_g and p_q are assumed to be shared by the two product generations. I thus use nls to joinly estimate M1, M2, q_g and p_q.
The problem arise in the regression results, that yield the following:
Parameters:
Estimate Std. Error t value Pr(>|t|)
M1 57272.955000 5132.566387 11.159 < 0.0000000000000002 ***
M2 65083.042585 9151.330507 7.112 0.0000000000872 ***
P 0.043177 0.003957 10.913 < 0.0000000000000002 ***
Q -0.082847 0.007974 -10.390 < 0.0000000000000002 ***
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 3487 on 121 degrees of freedom
Number of iterations to convergence: 10
Achieved convergence tolerance: 0.000002792
By definition, all estimated parameters should be >0, and in my results, q is negative. I have tried adding lower bounds to the parameter estimates of 0, but this just yields q = 0, which I also believe is wrong.
I thus wonder if I am providing inputs that are not feasible for NLS - in particular the way I am assigning the time variables to the model. Please find the data and code that I am executing.
Any inputs to if I am doing it wrong - and how to resolve it - would be highly appreciated.
s1 <- c(885.0,780.0,14610.0,13035.0,10395.0,12390.0,16260.0,14550.0,13073.0,19639.5,12675.0,15870.0,18615.0,17231.0,16159.0,19500.0,18135.0,13845.0,20175.0,18210.0,22110.0,17925.0,13770.0,17040.0,18076.5,23008.5,18270.0,20820.0,19275.0,22140.0,21300.0,22350.0,22185.0,24495.0,19605.0,21945.0,18855.0,26340.0,28515.0,26190.0,23895.0,29700.0,30525.0,28740.0,30930.0,25875.0,27720.0,29895.0,28710.0,30060.0,31485.0,30435.0,32730.0,33525.0,31725.0,32325.0,35580.0,34230.0,22380.0,28440.0,21225.0,24765.0,26520.0,21180.0,25260.0,21975.0,22455.0,29805.0,19185.0,20850.0,16170.0,20265.0,19500.0,20000.0,19450.0,18950.0,20500.0,18750.0,18649.5,17000.0,16000.0,16700.0,17500.0,16000.0,15900.0,15650.0,15250.0,15000.0,14500.0,14550.0)
s2.new <- c(2025.0,7077.5,12660.0,14235.0,23115.0,18180.0,25680.0,27210.0,25740.0,27120.0,28725.0,27435.0,35550.0,28635.0,34440.0,29160.0,34500.0,36100.0,35650.0,36500.0,36700.0,36250.0,37100.0,39000.0,37000.0,37500.0,39500.0,40000.0,39000.0,38500.0,39500.0,38750.0,38000.0,37900.0,34500.0)
S <- c(s1, s2.new)
T<-1:90
Tau2<-56
T.new<-c(56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90)
T2.new<-c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35)
fo12 <- S ~ c(M1*((1-exp(-(P+Q)*T))/((Q/P)*exp(-(P+Q)*T)+1))*
ifelse((T-Tau2)>=0,(1-((1-exp(-(P+Q)*(T-Tau2)))/((Q/P)*exp(-(P+Q)*(T-Tau2))+1))),1),
(M2 + M1*((1-exp(-(P+Q)*T.new))/((Q/P)*exp(-(P+Q)*T.new)+1)))*
((1-exp(-(P+Q)*T2.new))/((Q/P)*exp(-(P+Q)*T2.new)+1)))
S.func <- nls(fo12, start= c(list(M1=sum(s1), M2=100000, P=0.01, Q=0.001)))
summary(S.func)
