Fehleranpassung Funktion zu Daten mit nls

Question

Ich habe ein Problem mit nls() Parameter zu schätzen. Ich habe eine folgende Gruppe von Funktionen, einige Daten in der Hand zu erklären:

funk1 <- function(a,x) { x^2*exp(-(l*(1-exp(-r*a))/r)) } 

funk2 <- function(x) { sapply(x, function (s) 
{ integrate(funk1, lower = 0, upper = s, x=s)$value }) } 

Ich versuche funk2 zu y zu passen:

y <- sort(runif(100, 0, 10^8)) 

Wenn ich nls():

nls(y ~ funk2(z1$days.post.bmt), data= z1, start=list(l=0.02, r=0.002), trace=T) 

es zeigt mir folgenden Fehler:

Error in f(x, ...) : object 'l' not found

Ist das nicht der ganze Sinn des nls() unterschiedliche Werte für die Parameter l und r von Parameterraum zu ersetzen, die Funktion durch Minimierung SSR und gibt die Parameterschätzungen passen? Warum braucht es einen Wert von l, damit es funktioniert? Ich vermisse definitiv etwas Großes hier. Bitte helfen Sie!

Vielen Dank im Voraus!

Answer 1

Sie müssen Parameter l und r als Funktionsargumente von funk1 und funk2 passieren.

funk1 <- function(a,x,l,r) { 
    x^2*exp(-(l*(1-exp(-r*a))/r)) 
    } 

funk2 <- function(x,l,r) { 
    sapply(x, function (s) { 
       integrate(funk1, lower = 0, upper = s, x=s, l=l, r=r)$value 
       }) 
    } 

Ich werde einige Daten Test erzeugen:

z <- data.frame(days.post.bmt = 1:100, 
       y = funk2(1:100, l = 1, r = 1) + rpois(100, 1:100)) 

nls(y ~ funk2(days.post.bmt,l,r), data = z, start = list(l = 0.5, r = 0.5)) 

#Nonlinear regression model 
# model: y ~ funk2(days.post.bmt, l, r) 
# data: z 
#  l  r 
#0.9405 0.9400 
# residual sum-of-squares: 6709 

#Number of iterations to convergence: 5 
#Achieved convergence tolerance: 2.354e-07 

Als Gegen Beispiel betrachten:

bad_funk1 <- function(a,x) { 
    x^2*exp(-(l*(1-exp(-r*a))/r)) 
    } 

bad_funk2 <- function(x) { 
    sapply(x, function (s) { 
       integrate(funk1, lower = 0, upper = s, x=s)$value 
       }) 
    } 

nls(y ~ bad_funk2(days.post.bmt), data = z, start = list(l = 0.5, r = 0.5)) 
# Error in f(x, ...) (from #2) : argument "l" is missing, with no default