Tôi đang cố gắng điều chỉnh hàm phân rã theo hàm mũ cho các giá trị y trở thành âm ở giá trị x cao, nhưng không thể định cấu hình nlschính xác chức năng của tôi .

Mục đích

Tôi quan tâm đến độ dốc của hàm phân rã ( theo một số nguồn ). Làm thế nào tôi có được độ dốc này không quan trọng, nhưng mô hình phải phù hợp với dữ liệu của tôi nhất có thể (nghĩa là tuyến tính hóa vấn đề có thể chấp nhận được , nếu sự phù hợp là tốt; xem "tuyến tính hóa"). Tuy nhiên, các công trình trước đây về chủ đề này đã sử dụng hàm phân rã theo cấp số nhân sau ( bài viết truy cập đóng của Stedmon et al., Phương trình 3 ): $\lambda$

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

nơi Scó độ dốc Tôi đang quan tâm, Kcác yếu tố điều chỉnh để cho phép các giá trị âm và agiá trị ban đầu cho x(tức là đánh chặn).

Tôi cần phải làm điều này trong R, vì tôi đang viết một hàm chuyển đổi các phép đo thô của chất hữu cơ hòa tan chromophoric (CDOM) thành các giá trị mà các nhà nghiên cứu quan tâm.

Dữ liệu mẫu

Do tính chất của dữ liệu, tôi đã phải sử dụng PasteBin. Các dữ liệu ví dụ có sẵn ở đây .

Viết dt <-và sao chép mã fom PasteBin vào bảng điều khiển R của bạn. I E

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

Dữ liệu trông như thế này:

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

Giá trị y âm diễn ra khi . $x > 540 nm$

Đang cố gắng tìm giải pháp bằng cách sử dụng `nls`

Nỗ lực ban đầu bằng cách sử dụng nlstạo ra một điểm kỳ dị, điều không nên ngạc nhiên khi thấy rằng tôi chỉ nhìn thấy các giá trị bắt đầu cho các tham số:

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

Theo câu trả lời này , tôi có thể cố gắng tạo ra các tham số khởi động phù hợp tốt hơn để giúp nlschức năng:

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

Hàm dường như không thể tìm thấy một giải pháp với số lần lặp mặc định. Hãy tăng số lần lặp:

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

Nhiều lỗi hơn. Chộp lấy nó! Chúng ta hãy buộc hàm cung cấp cho chúng ta một giải pháp:

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")

Chà, đây chắc chắn không phải là một giải pháp tốt ...

Tuyến tính hóa vấn đề

Nhiều người đã tuyến tính hóa các hàm phân rã theo cấp số nhân của họ với một thành công (nguồn: 1 , 2 , 3 ). Trong trường hợp này, chúng tôi cần đảm bảo rằng không có giá trị y nào âm hoặc 0. Hãy tạo giá trị y tối thiểu càng gần 0 càng tốt trong giới hạn dấu phẩy động của máy tính :

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")

Tốt hơn nhiều, nhưng mô hình không theo dõi các giá trị y một cách hoàn hảo ở các giá trị x thấp.

Lưu ý rằng nlshàm vẫn sẽ không quản lý để phù hợp với phân rã theo cấp số nhân:

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

Các giá trị âm có quan trọng không?

Các giá trị âm rõ ràng là một lỗi đo lường vì hệ số hấp thụ không thể âm. Vậy điều gì sẽ xảy ra nếu tôi làm cho các giá trị y trở nên tích cực? Đó là độ dốc tôi quan tâm. Nếu bổ sung không ảnh hưởng đến độ dốc, tôi nên giải quyết:

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")

Chà, điều này không thành công lắm ... Giá trị x cao rõ ràng nên càng gần 0 càng tốt.

Câu hỏi

Tôi rõ ràng đang làm điều gì đó sai ở đây. Cách chính xác nhất để ước tính độ dốc cho hàm phân rã theo hàm mũ được trang bị trên dữ liệu có giá trị y âm sử dụng R là gì?

r model exponential

— Mikko
nguồn

1

nlshội tụ cho tôi bằng cách sử dụng các giá trị bắt đầu . Ngoài ra, bạn có thể sử dụng chức năng tự khởi động : . Điều đó hội tụ cho tôi quá.

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

$a=1, S =0.01, K=-0.0001$ nls(y~SSasymp(x, Asym, r0, lrc), data = dt)

— COOLSerdash

10

Sử dụng chức năng tự khởi động:

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

Tuy nhiên, tôi sẽ nghiêm túc xem xét nếu kiến thức tên miền của bạn không biện minh cho việc đặt tiệm cận thành không. Tôi tin là có và mô hình trên không đồng ý (xem lỗi tiêu chuẩn / giá trị p của hệ số).

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
nguồn

Hoàn hảo. Tôi không biết về SSasympchức năng. Cảm ơn bạn! Tôi tin rằng các nhà nghiên cứu muốn đề cập đến bài báo tôi đã trích dẫn trong câu hỏi và sử dụng Kthuật ngữ này, nhưng tôi sẽ đề nghị họ sửa đổi phương trình của họ. Tôi nghĩ rằng họ muốn giữ K, bởi vì các giá trị âm có nghĩa là nhạc cụ không hoạt động như mong đợi, nhưng họ quan tâm đến độ dốc. Loại bỏ tiệm cận âm có thể ảnh hưởng đến độ dốc trong một số trường hợp.

— Mikko

@Mikko Nếu bạn đo mức độ hấp thụ và tiệm cận có giá trị bằng 0, tôi sẽ nói rằng bạn có vấn đề với hiệu chuẩn hoặc độ ổn định của thiết bị.

— Roland

Vấn đề thường xảy ra khi nước rất trong (nước đại dương). Một số giá trị trở thành dưới không. Tôi nghĩ rằng chúng ta có một công cụ bị các vấn đề nhiệt độ. Khi nó quá nóng, các giá trị trở nên không ổn định, nhưng những chi tiết này có lẽ không nên được xử lý trong Crossvalidated.

— Mikko

3

Câu hỏi này có mối quan hệ với một số câu hỏi khác

Tôi có ba nhận xét bổ sung về một số điểm trong câu hỏi này.

1: Tại sao mô hình tuyến tính hóa không phù hợp với các giá trị lớn của $y$

Tốt hơn nhiều, nhưng mô hình không theo dõi các giá trị y một cách hoàn hảo ở các giá trị x thấp.

Sự phù hợp tuyến tính hóa không giảm thiểu các phần dư tương tự. Ở thang đo logarit, phần dư cho các giá trị nhỏ hơn sẽ lớn hơn. Hình ảnh bên dưới hiển thị so sánh bằng cách vẽ trục y theo tỷ lệ nhật ký trong hình ảnh bên phải:

Khi cần thiết bạn có thể thêm trọng số cho hàm mất bình phương nhỏ nhất.

2: Sử dụng sự phù hợp tuyến tính làm giá trị bắt đầu

Sau khi bạn có được các ước tính với sự phù hợp tuyến tính hóa của mình, bạn có thể sử dụng chúng làm điểm bắt đầu cho sự phù hợp phi tuyến tính. *

# 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: Sử dụng phương pháp tổng quát hơn để có được điểm bắt đầu

Nếu bạn có đủ điểm thì bạn cũng có thể có được độ dốc mà không phải lo lắng về giá trị tiệm cận và giá trị âm (không cần tính toán logarit).

Bạn có thể làm điều này bằng cách tích hợp các điểm dữ liệu. Sau đó, với và bạn có thể sử dụng mô hình tuyến tính để lấy giá trị của bằng cách mô tả dưới dạng kết hợp tuyến tính của các vectơ , và một chặn:

y = a e^{s x} + k

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

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

$Y = \frac{a}{s} e^{sx} + kx + Const$

s

$s$

y

$y$

Y

$Y$

x

$x$

\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}$

Ưu điểm của phương pháp này (xem Tittelbach và Helmrich 1993 "Phương pháp tích hợp để phân tích tín hiệu nhất thời đa tín hiệu" ) là bạn có thể mở rộng nó thành nhiều hơn một thành phần phân rã theo cấp số nhân (thêm nhiều tích phân).

#
# 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))

Lưu ý: * Việc sử dụng độ dốc trong bài toán tuyến tính này chính xác là những gì SSasympchức năng tự khởi động làm. Đầu tiên, nó ước tính tiệm cận

> 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
}

và sau đó độ dốc bằng cách (trừ giá trị tiệm cận và lấy các giá trị nhật ký)

> 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"))
}

Lưu ý dòng start = list(lrc = log(-coef(lm(log(abs(y - rt)) ~ x, data = xy))[[2L]]))

Sidenote: Trong trường hợp đặc biệt mà bạn có thể sử dụng $K=0$

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

mô hình tham số quan sát là $y$

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
nguồn

Phù hợp với phân rã theo cấp số nhân với các giá trị y âm