Как минимизировать остаточную сумму квадратов экспоненциальной подгонки?

У меня есть следующие данные, и я хотел бы приспособить к ним модель отрицательного экспоненциального роста:

Days <- c( 1,5,12,16,22,27,36,43)
Emissions <- c( 936.76, 1458.68, 1787.23, 1840.04, 1928.97, 1963.63, 1965.37, 1985.71)
plot(Days, Emissions)
fit <- nls(Emissions ~ a* (1-exp(-b*Days)), start = list(a = 2000, b = 0.55))
curve((y = 1882 * (1 - exp(-0.5108*x))), from = 0, to =45, add = T, col = "green", lwd = 4)

Код работает и строится подходящая линия. Тем не менее, подгонка визуально не идеальна, а остаточная сумма квадратов кажется довольно большой (147073).

Как мы можем улучшить нашу форму? Данные позволяют лучше соответствовать вообще?

Мы не смогли найти решение этой проблемы в сети. Любая прямая помощь или связь с другими сайтами / сообщениями с благодарностью.

r nonlinear-regression fitting nls

— Strohmi
источник

В этом случае, если рассмотреть модель регрессии

, где

, то получит аналогичные оценщик. Составляя график областей доверия, можно наблюдать, как эти значения содержатся в областях доверия. Вы не можете ожидать идеальной подгонки, если не будете интерполировать точки или использовать более гибкую нелинейную модель.

{Emissions}_{i} = f ({Days}_{i}, a, b) + ϵ_{i}

$\text{Emissions}_i=f(\text{Days}_i,a,b)+\epsilon_i$

ϵ_{i} \sim N (0, σ)

$\epsilon_i\sim N(0,\sigma)$

Я изменил название, потому что «отрицательная экспоненциальная модель» означает нечто иное, чем описано в вопросе.

— whuber

Спасибо за разъяснение вопроса (@whuber) и за ответ (@Procrastinator). Как я могу рассчитать и построить доверительные регионы. И что будет более гибкой нелинейной моделью?

— Строхми

Вам нужен дополнительный параметр. Посмотрите, что происходит с

fit <- nls(Emissions ~ a* (1- u*exp(-b*Days)), start = list(a = 2000, b = 0.1, u=.5));  beta <- coefficients(fit); curve((y = beta["a"] * (1 - beta["u"] * exp(-beta["b"]*x))), add = T)

— whuber

@whuber - может быть, вы должны опубликовать это как ответ?

— jbowman

(Отрицательный) экспоненциальный закон принимает вид . Когда вы допускаете изменения единиц в значениях и , хотя, скажем, и , тогда закон будет выражаться как $y=-\exp(-x)$ $x$ $y$ $y = \alpha y' + \beta$ $x = \gamma x' + \delta$

α y^{'} + β = y = - \exp (- x) = - \exp (- γ x^{'} - δ),

$\alpha y' + \beta = y = -\exp(-x) = -\exp(-\gamma x' - \delta),$

который алгебраически эквивалентен

y^{'} = \frac{- 1}{α} \exp (- γ x^{'} - δ) - β = a (1 - u \exp (- b x^{'}))

$y' = \frac{-1}{\alpha} \exp(-\gamma x' - \delta) - \beta = a\left(1 - u\exp(-b x')\right)$

используя три параметра , и . Мы можем распознать как параметр масштаба для , как параметр масштаба для , и как производный от параметра местоположения для . $a = -\beta/\alpha$ $u = 1/(\beta\exp(\delta))$ $b = \gamma$ $a$ $y$ $b$ $x$ $u$ $x$

Как правило, эти параметры можно определить с первого взгляда на график :

Параметр - это значение горизонтальной асимптоты, чуть меньше . $a$ $2000$
Параметр - это относительная величина, на которую кривая поднимается от начала координат до ее горизонтальной асимптоты. Здесь, следовательно, рост немного меньше, чем ; относительно, это около асимптоты. $u$ $2000 - 937$ $0.55$
Поскольку , когда три раза превышает значение кривая должна была подняться примерно до или от общей суммы. роста с до почти ставит нас около ; сканирование по всему графику показывает, что это заняло от до дней. Давайте назовем это для простоты, откуда $\exp(-3) \approx 0.05$ $x$ $1/b$ $1-0.05$ $95\%$ $95\%$ $937$ $2000$ $1950$ $20$ $25$ $24$ . (Этотметод для экспоненциальной шкалы является стандартным в некоторых областях, которые часто используют экспоненциальные графики.) $b \approx 3/24 = 0.125$ $95\%$

Давайте посмотрим, как это выглядит:

plot(Days, Emissions)
curve((y = 2000 * (1 - 0.56 * exp(-0.125*x))), add = T)

Глазное яблоко

Не плохо для начала! (Даже несмотря на то, что вы печатаете 0.56вместо 0.55, это было грубое приближение в любом случае.) Мы можем отшлифовать его с помощью nls:

fit <- nls(Emissions ~ a * (1- u * exp(-b*Days)), start=list(a=2000, b=1/8, u=0.55))
beta <- coefficients(fit)
plot(Days, Emissions)
curve((y = beta["a"] * (1 - beta["u"] * exp(-beta["b"]*x))), add = T, col="Green", lwd=2)

NLS подходит

Вывод nlsсодержит обширную информацию о параметре неопределенности. Например , простое summaryпредоставляет стандартные ошибки оценок:

> summary(fit)

Parameters:
   Estimate Std. Error t value Pr(>|t|)    
a 1.969e+03  1.317e+01  149.51 2.54e-10 ***
b 1.603e-01  1.022e-02   15.69 1.91e-05 ***
u 6.091e-01  1.613e-02   37.75 2.46e-07 ***

Мы можем читать и работать со всей ковариационной матрицей оценок, что полезно для оценки одновременных доверительных интервалов (по крайней мере, для больших наборов данных):

> vcov(fit)
             a             b             u
a 173.38613624 -8.720531e-02 -2.602935e-02
b  -0.08720531  1.044004e-04  9.442374e-05
u  -0.02602935  9.442374e-05  2.603217e-04

nls поддерживает графики профиля для параметров, предоставляя более подробную информацию об их неопределенности:

> plot(profile(fit))

$a$

Профиль участка

$2$ $1945$ $1995$

— Whuber
источник

res <- residuals(fit); res %*% res

u

$u$

2724

$2724$

147073

$147073$

Все хорошо и хорошо. Но, возможно, у ОП была причина выбрать экспоненциальную модель (или, может быть, это просто потому, что она хорошо известна). Я думаю, что сначала следует рассмотреть остатки для экспоненциальной модели. Поместите их против потенциальных ковариат, чтобы увидеть, есть ли там структура, а не просто большой случайный шум. Прежде чем перейти к более сложным моделям, попробуйте посмотреть, может ли более полезная модель помочь.

— Майкл Р. Черник

x

$x$

Я не критиковал ваш ответ! Я не видел никаких остаточных участков. Все, что я предлагал, это то, что графики остатков и потенциальных ковариат должны быть первым шагом в поиске лучшей модели. Если бы я думал, что у меня есть ответ на этот вопрос, я бы дал ответ, а не поднял бы мою точку зрения как постоянную. Я думал, что вы дали отличный ответ, и я был среди тех, кто дал вам +1.

— Майкл Р. Черник