Ich versuche, eine exponentielle Abklingfunktion an y-Werte anzupassen, die bei hohen x-Werten negativ werden, kann meine nlsFunktion jedoch nicht richtig konfigurieren .

Ziel

Ich interessiere mich für die Steigung der Abklingfunktion ( $\lambda$ nach einigen Quellen ). Wie ich diese Steigung erhalte, ist nicht wichtig, aber das Modell sollte so gut wie möglich zu meinen Daten passen (dh eine Linearisierung des Problems ist akzeptabel , wenn die Anpassung gut ist; siehe "Linearisierung"). In früheren Arbeiten zu diesem Thema wurde jedoch eine folgende exponentielle Abklingfunktion verwendet ( Artikel mit geschlossenem Zugriff von Stedmon et al., Gleichung 3 ):

$f(y) = a \times exp(-S \times x) + K$

Wo Sist die Steigung, die mich interessiert, Kder Korrekturfaktor, um negative Werte zuzulassen, und ader Anfangswert für x(dh Achsenabschnitt).

Ich muss dies in R tun, da ich eine Funktion schreibe, die Rohmessungen von chromophoren gelösten organischen Stoffen (CDOM) in Werte umwandelt, an denen Forscher interessiert sind.

Beispieldaten

Aufgrund der Art der Daten musste ich PasteBin verwenden. Die Beispieldaten finden Sie hier .

Schreiben Sie dt <-den Code von PasteBin und kopieren Sie ihn in Ihre R-Konsole. Dh

dt <- structure(list(x = ...

Die Daten sehen folgendermaßen aus:

library(ggplot2)
ggplot(dt, aes(x = x, y = y)) + geom_point()

Negative y-Werte treten auf, wenn . $x > 540 nm$

Ich versuche eine Lösung zu finden mit `nls`

Der erste Versuch, nlseine zu verwenden, erzeugt eine Singularität, was keine Überraschung sein sollte, da ich nur die Startwerte für Parameter betrachtet habe:

nls(y ~ a * exp(-S * x) + K, data = dt, start = list(a = 0.5, S = 0.1, K = -0.1))

# Error in nlsModel(formula, mf, start, wts) : 
#  singular gradient matrix at initial parameter estimates

Nach dieser Antwort kann ich versuchen, die Startparameter besser anzupassen, um die nlsFunktion zu unterstützen:

K0 <- min(dt$y)/2
mod0 <- lm(log(y - K0) ~ x, data = dt) # produces NaNs due to the negative values
start <- list(a = exp(coef(mod0)[1]), S = coef(mod0)[2], K = K0)
nls(y ~ a * exp(-S * x) + K, data = dt, start = start)

# Error in nls(y ~ a * exp(-S * x) + K, data = dt, start = start) : 
#  number of iterations exceeded maximum of 50

Die Funktion scheint nicht in der Lage zu sein, eine Lösung mit der Standardanzahl von Iterationen zu finden. Erhöhen wir die Anzahl der Iterationen:

nls(y ~ a * exp(-S * x) + K, data = dt, start = start, nls.control(maxiter = 1000))

# Error in nls(y ~ a * exp(-S * x) + K, data = dt, start = start, nls.control(maxiter = 1000)) : 
#  step factor 0.000488281 reduced below 'minFactor' of 0.000976562

Weitere Fehler. Chuck es! Erzwingen wir einfach die Funktion, um uns eine Lösung zu geben:

mod <- nls(y ~ a * exp(-S * x) + K, data = dt, start = start, nls.control(maxiter = 1000, warnOnly = TRUE))
mod.dat <- data.frame(x = dt$x, y = predict(mod, list(wavelength = dt$x)))

ggplot(dt, aes(x = x, y = y)) + geom_point() + 
  geom_line(data = mod.dat, aes(x = x, y = y), color = "red")

Nun, das war definitiv keine gute Lösung ...

Das Problem linearisieren

Viele Menschen haben ihre exponentiellen Zerfallsfunktionen mit Erfolg linearisiert (Quellen: 1 , 2 , 3 ). In diesem Fall müssen wir sicherstellen, dass kein y-Wert negativ oder 0 ist. Lassen Sie uns den minimalen y-Wert innerhalb der Gleitkomma-Grenzen von Computern so nahe wie möglich an 0 bringen :

K <- abs(min(dt$y)) 
dt$y <- dt$y + K*(1+10^-15)

fit <- lm(log(y) ~ x, data=dt)  
ggplot(dt, aes(x = x, y = y)) + geom_point() + 
geom_line(aes(x=x, y=exp(fit$fitted.values)), color = "red")

Viel besser, aber das Modell verfolgt y-Werte bei niedrigen x-Werten nicht perfekt.

Beachten Sie, dass die nlsFunktion immer noch nicht zum exponentiellen Zerfall passt:

K0 <- min(dt$y)/2
mod0 <- lm(log(y - K0) ~ x, data = dt) # produces NaNs due to the negative values
start <- list(a = exp(coef(mod0)[1]), S = coef(mod0)[2], K = K0)
nls(y ~ a * exp(-S * x) + K, data = dt, start = start)

# Error in nlsModel(formula, mf, start, wts) : 
#  singular gradient matrix at initial parameter estimates

Sind die negativen Werte wichtig?

Die negativen Werte sind offensichtlich ein Messfehler, da die Absorptionskoeffizienten nicht negativ sein können. Was ist, wenn ich die y-Werte großzügig positiv mache? Es ist die Steigung, die mich interessiert. Wenn die Addition die Steigung nicht beeinflusst, sollte ich abgerechnet werden:

dt$y <- dt$y + 0.1

fit <- lm(log(y) ~ x, data=dt)  
ggplot(dt, aes(x = x, y = y)) + geom_point() + geom_line(aes(x=x, y=exp(fit$fitted.values)), color = "red")

Nun, das lief nicht so gut ... Hohe x-Werte sollten offensichtlich so nahe wie möglich bei Null liegen.

Die Frage

Ich mache hier offensichtlich etwas falsch. Was ist der genaueste Weg, um die Steigung für eine exponentielle Abklingfunktion zu schätzen, die an Daten mit negativen y-Werten unter Verwendung von R angepasst ist?

r model exponential

— Mikko
quelle

1

nls konvergierte für mich mit den Startwerten

a = 1, S = 0.01, K = - 0.0001

$a=1, S =0.01, K=-0.0001$ . Alternativ können Sie die Selbststartfunktion verwenden : nls(y~SSasymp(x, Asym, r0, lrc), data = dt). Das konvergiert auch für mich.

— COOLSerdash

10

Verwenden Sie eine Selbststartfunktion:

ggplot(dt, aes(x = x, y = y)) + 
  geom_point() +
  stat_smooth(method = "nls", formula = y ~ SSasymp(x, Asym, R0, lrc), se = FALSE)

fit <- nls(y ~ SSasymp(x, Asym, R0, lrc), data = dt)
summary(fit)
#Formula: y ~ SSasymp(x, Asym, R0, lrc)
#
#Parameters:
#       Estimate Std. Error  t value Pr(>|t|)    
#Asym -0.0001302  0.0004693   -0.277    0.782    
#R0   77.9103278  2.1432998   36.351   <2e-16 ***
#lrc  -4.0862443  0.0051816 -788.604   <2e-16 ***
#---
#Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
#
#Residual standard error: 0.007307 on 698 degrees of freedom
#
#Number of iterations to convergence: 0 
#Achieved convergence tolerance: 9.189e-08

exp(coef(fit)[["lrc"]]) #lambda
#[1] 0.01680222

Ich würde jedoch ernsthaft darüber nachdenken, ob Ihr Domain-Wissen es nicht rechtfertigt, die Asymptote auf Null zu setzen. Ich glaube, dass dies der Fall ist und das obige Modell nicht anderer Meinung ist (siehe Standardfehler / p-Wert des Koeffizienten).

ggplot(dt, aes(x = x, y = y)) + 
  geom_point() +
  stat_smooth(method = "nls", formula = y ~ a * exp(-S * x), 
              method.args = list(start = list(a = 78, S = 0.02)), se = FALSE, #starting values obtained from fit above
              color = "dark red")

— Roland
quelle

Perfekt. Ich wusste nichts über SSasympFunktion. Vielen Dank! Ich glaube, die Forscher möchten sich auf den Artikel beziehen, den ich in der Frage zitiert habe, und den KBegriff verwenden, aber ich werde ihnen vorschlagen, ihre Gleichung zu ändern. Ich denke, sie wollen das behalten K, weil negative Werte bedeuten, dass sich das Instrument nicht wie erwartet verhalten hat, aber sie sind an der Steigung interessiert. Das Entfernen der negativen Asymptote kann in einigen Fällen die Steigung beeinflussen.

— Mikko

@Mikko Wenn Sie die Absorption messen und die Asymptote signifikant Null wird, würde ich sagen, dass Sie Probleme mit Ihrer Kalibrierung oder Instrumentenstabilität haben.

— Roland

Das Problem tritt häufig auf, wenn das Wasser sehr klar ist (ozeanisches Wasser). Einige Werte werden unter Null. Ich denke, wir haben ein Instrument, das unter Temperaturproblemen leidet. Wenn es überhitzt, werden die Werte instabil, aber diese Details sollten wahrscheinlich nicht in Crossvalidated behandelt werden.

— Mikko

3

Diese Frage hat Beziehungen zu mehreren anderen Fragen

Ich habe drei zusätzliche Bemerkungen zu einigen Punkten in dieser Frage.

1: Warum das linearisierte Modell nicht gut zu den großen Werten von passt $y$

Viel besser, aber das Modell verfolgt y-Werte bei niedrigen x-Werten nicht perfekt.

Die linearisierte Anpassung minimiert nicht die gleichen Residuen. Auf der logarithmischen Skala sind die Residuen für kleinere Werte größer. Das Bild unten zeigt den Vergleich durch Auftragen der y-Achse auf einer logarithmischen Skala im rechten Bild:

Bei Bedarf können Sie der Verlustfunktion für kleinste Quadrate Gewichte hinzufügen.

2: Verwenden der linearisierten Anpassung als Startwerte

Nachdem Sie Schätzungen mit Ihrer linearisierten Anpassung erhalten haben, können Sie diese als Ausgangspunkt für die nichtlineare Anpassung verwenden. *

# vectors x and y from data
x <- dat$x
y <- dat$y

# linearized fit with zero correction
K <- abs(min(y)) 
dty <- y + K*(1+10^-15)
fit <- lm(log(dty) ~x)  


# old fit that had a singluar gradient matrix error
#         nls(y ~ a * exp(-S * x) + K, 
#                 start = list(a = 0.5, 
#                              S = 0.1, 
#                              K = -0.1))
#

# new fit
fitnls <- nls(y ~ a * exp(-S * x) + K, 
                  start = list(a = exp(fit$coefficients[1]), 
                               S = -fit$coefficients[2], 
                               K = -0.1))
#

3: Verwenden einer allgemeineren Methode, um den Ausgangspunkt zu erhalten

Wenn Sie genügend Punkte haben, können Sie auch die Steigung erhalten, ohne sich um asymptotische Werte und negative Werte kümmern zu müssen (keine Berechnung eines Logarithmus erforderlich).

Sie können dies tun, indem Sie die Datenpunkte integrieren. Dann mit

y = a e^{s x} + k

$y = a e^{sx} + k$ und

Y = \frac{a}{s} e^{s x} + k x + C o n s t

$Y = \frac{a}{s} e^{sx} + kx + Const$ Sie können ein lineares Modell verwenden, um den Wert von zu erhalten

s

$s$ durch beschreiben

y

$y$ als lineare Kombination der Vektoren

Y

$Y$ ,

x

$x$ und ein Abschnitt:

\begin{array}{rccccl} y & = & a e^{s x} + k & = & s (\frac{a}{s} e^{s x} + k x + C o n s t) & - s k x - s C o n s t \\ = & s Y & - s k x - s C o n s t \end{array}

$\begin{array}{rccccl}y &=& a e^{sx} + k &=& s(\frac{a}{s} e^{s x} + k x + Const) &- s k x - s Const \\ &&&=& sY &- sk x - s Const \end{array}$

Der Vorteil dieser Methode (siehe Tittelbach und Helmrich 1993 "Eine Integrationsmethode zur Analyse multiexponentieller transienter Signale" ) besteht darin, dass Sie sie auf mehr als eine einzelne exponentiell abfallende Komponente erweitern können (Hinzufügen weiterer Integrale).

#
# using Tittelbach Helmrich
#

# integrating with trapezium rule assuming x variable is already ordered
ys <- c(0,cumsum(0.5*diff(x)*(y[-1]+y[-length(y)])))

# getting slope parameter
modth <- lm(y ~ ys + x)
slope <- modth$coefficients[2]

# getting other parameters 
modlm <- lm(y ~ 1 + I(exp(slope*x)))
K <- modlm$coefficients[1]
a <- modlm$coefficients[2]

# fitting with TH start

fitnls2 <- nls(y ~ a * exp(-S * x) + K, 
              start = list(a = a, 
                           S = -slope, 
                           K = K))

Fußnote: * Diese Verwendung der Steigung im linearisierten Problem ist genau das, was die SSasympSelbststartfunktion bewirkt. Es schätzt zuerst die Asymptote

> stats:::NLSstRtAsymptote.sortedXyData
function (xy) 
{
    in.range <- range(xy$y)
    last.dif <- abs(in.range - xy$y[nrow(xy)])
    if (match(min(last.dif), last.dif) == 2L) 
        in.range[2L] + diff(in.range)/8
    else in.range[1L] - diff(in.range)/8
}

und dann die Steigung durch (Subtrahieren des Asymptotenwerts und Nehmen der logarithmischen Werte)

> stats:::NLSstAsymptotic.sortedXyData
function (xy) 
{
    xy$rt <- NLSstRtAsymptote(xy)
    setNames(coef(nls(y ~ cbind(1, 1 - exp(-exp(lrc) * x)), data = xy, 
        start = list(lrc = log(-coef(lm(log(abs(y - rt)) ~ x, 
            data = xy))[[2L]])), algorithm = "plinear"))[c(2, 
        3, 1)], c("b0", "b1", "lrc"))
}

Beachten Sie die Zeile start = list(lrc = log(-coef(lm(log(abs(y - rt)) ~ x, data = xy))[[2L]]))

Nebenbemerkung: Im Sonderfall das $K=0$ Sie können verwenden

plot(x,y)
mod <- glm(y~x, family = gaussian(link = log), start = c(2,-0.01))
lines(x,exp(predict(mod)),col=2)

welches den beobachteten Parameter modelliert $y$ wie

y = e x p (X β) + ϵ = e x p (β_{0}) \cdot e x p (β_{1} \cdot x) + ϵ

$y = exp(X\beta) + \epsilon = exp(\beta_0) \cdot exp(\beta_1 \cdot x) + \epsilon$

— Sextus Empiricus
quelle

Anpassung des exponentiellen Zerfalls mit negativen y-Werten