高い減衰値で負になるy値に指数関数的減衰関数を適合させようとしていますが、nls関数を正しく構成できません。

目的

減衰関数の傾きに興味があります（いくつかの情報源によると）。この勾配をどのように取得するかは重要ではありませんが、モデルはできる限りデータに適合している必要があります（つまり、適合が良好であれば、問題の線形化は許容可能です。「線形化」を参照してください）。しかし、このトピックに関するこれまでの研究では、次の指数関数的減衰関数を使用しています（Stedmon et al。によるクローズドアクセスの記事、方程式3）。 $\lambda$

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

ここSで、私が関心を持っている勾配は、K負の値とa初期値x（つまり切片）を許可するための補正係数です。

私はこれをRで行う必要があります。発色団溶存有機物（CDOM）の生の測定値を研究者が興味のある値に変換する関数を書いているからです。

データの例

データの性質上、PasteBinを使用する必要がありました。例えば、データはこちらから入手できます。

書くdt <-とあなたのRコンソールにコードFOMペーストビンをコピーします。すなわち

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

データは次のようになります。

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

場合、負のy値が発生します。 $x > 540 nm$

を使用して解決策を見つけようとしています `nls`

を使用nlsして最初に試行すると、特異性が生じます。これは、パラメータの開始値を目で確認しただけであっても、驚くことではありません。

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

この答えに従って、nls関数を助けるために、より適切な開始パラメータを作成することができます。

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

関数は、デフォルトの反復回数では解を見つけることができないようです。反復回数を増やしましょう：

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

その他のエラー。それをチャック！関数に強制的に解を与えましょう：

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

まあ、これは間違いなく良い解決策ではありませんでした...

問題の線形化

多くの人が成功し、その指数関数的減衰関数を線形化してきた（ソース：1、2、3）。この場合、yの値が負または0でないことを確認する必要があります。コンピューターの浮動小数点の制限内で、 yの最小値をできるだけ0に近づけましょう。

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

はるかに良いですが、モデルは低いx値で完全にy値をトレースしません。

nls関数は依然として指数関数的減衰に適合できないことに注意してください。

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

負の値は重要ですか？

吸収係数が負になることはできないため、負の値は明らかに測定誤差です。では、yの値を寛大に正にするとどうなるでしょうか。気になるスロープです。追加してもスロープに影響がなければ、解決するはずです。

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

まあ、これはうまくいきませんでした...高いx値は明らかに可能な限りゼロに近いはずです。

質問

私は明らかにここで何か間違ったことをしています。Rを使用して負のy値を持つデータに適合された指数関数減衰関数の勾配を推定する最も正確な方法は何ですか？

r model exponential

— ミッコ
ソース

1

nls開始値を使用して私のために収束しました。または、自動開始機能を使用することもできます。それも私にとって収束します。

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 2017

10

自動開始関数を使用します。

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

ただし、ドメインの知識が漸近線をゼロに設定することを正当化しない場合は、真剣に検討します。私はそれを信じており、上記のモデルは同意しません（標準誤差/係数のp値を参照）。

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

— ローランド
ソース

完璧です。SSasymp機能については知りませんでした。ありがとうございました！研究者は私が質問で引用した記事を参照し、K用語を使用したいと考えていますが、方程式を変更することを提案します。K負の値は楽器が期待どおりに動作しなかったことを意味するので、彼らはを維持したいと思いますが、勾配に関心があります。負の漸近線を削除すると、場合によっては勾配に影響を与える可能性があります。

— Mikko、

@Mikko吸収を測定し、漸近線が大幅にゼロになる場合、キャリブレーションまたは機器の安定性に問題があると思います。

— Roland

この問題は、水が非常に澄んでいるときに発生します（海水）。一部の値がゼロ未満になります。温度の問題がある機器があると思います。過熱すると値が不安定になりますが、これらの詳細はおそらくCrossvalidatedで処理するべきではありません。

— ミッコ

3

この質問は他のいくつかの質問と関係があります

この質問のいくつかの点に関して、3つの補足的なコメントがあります。

1：線形化モデルが大きな値にうまく適合しない理由 $y$

はるかに良いですが、モデルは低いx値で完全にy値をトレースしません。

線形化された近似は、同じ残差を最小化していません。対数目盛では、小さい値の残差は大きくなります。以下の画像は、右の画像の対数目盛にy軸をプロットして比較を示しています。

必要に応じて、最小二乗損失関数に重みを追加できます。

2：開始値として線形化フィットを使用

線形化された近似で推定値を取得したら、これらを非線形近似の開始点として使用できます。*

# 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：より一般的な方法を使用して開始点を取得する

十分なポイントがある場合は、漸近値や負の値を気にすることなく勾配を取得することもできます（対数の計算は必要ありません）。

データポイントを統合することでこれを行うことができます。次に、およびを使用して、線形モデルを使用し、を線形結合として記述することにより、の値を取得できます。ベクトル、および切片の：

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

この方法の利点（Tittelbach and Helmrich 1993 "Multiexponential Transient Signals of Analysis of the Multiexponential Transient Signals"を参照）は、単一の指数関数的に減衰する成分以上に拡張できる（積分を追加する）ことができます。

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

脚注： *この線形化された問題での勾配の使用は、SSasympセルフスタート機能が行うこととまったく同じです。最初に漸近線を推定します

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

次に勾配（漸近値を引いて対数値をとる）

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

行に注意してください start = list(lrc = log(-coef(lm(log(abs(y - rt)) ~ x, data = xy))[[2L]]))

傍注：特別な場合に使用できます $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)

そのモデル観測パラメータとして $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
ソース

負のy値による指数関数的減衰の近似

目的