Аналіз зміни точки за допомогою Rs nls ()

Я намагаюся здійснити аналіз "точки зміни" або багатофазну регресію за допомогою nls()Р.

Ось кілька фальшивих даних, які я зробив . Формула, яку я хочу використати для пристосування даних, така:

$y = \beta_0 + \beta_1x + \beta_2\max(0,x-\delta)$

Що потрібно зробити, це встановити дані до певної точки з певним перехопленням і нахилом ( і \ beta_1 ), після чого, після деякого значення x ( \ delta ), збільшуйте нахил на \ beta_2 . Ось у чому вся справа в максі. Перед точкою \ delta вона дорівнює 0, а \ beta_2 буде нульовим.$\beta_0$$\beta_1$$\delta$$\beta_2$$\delta$$\beta_2$

Отже, ось моя функція:

changePoint <- function(x, b0, slope1, slope2, delta){ 
   b0 + (x*slope1) + (max(0, x-delta) * slope2)
}

І я намагаюся таким чином підігнати модель

nls(y ~ changePoint(x, b0, slope1, slope2, delta), 
    data = data, 
    start = c(b0 = 50, slope1 = 0, slope2 = 2, delta = 48))

Я вибрав ці вихідні параметри, тому що знаю, що це вихідні параметри, тому що я склав дані.

Однак я отримую цю помилку:

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

Я щойно зробив невдалі дані? Спершу я спробував це встановити на реальних даних, і отримав таку ж помилку, і я просто зрозумів, що мої початкові параметри запуску були недостатньо хорошими.

(Спочатку я думав , що це може бути проблемою , в результаті чого з - за того , що maxНЕ векторизованних, але це не правда це. Дійсно зробити це біль роботи з Changepoint, тому наступної модифікації:

changePoint <- function(x, b0, slope1, slope2, delta) { 
   b0 + (x*slope1) + (sapply(x-delta, function (t) max(0, t)) * slope2)
}

Цей пост у списку розсилки R-довідки описує один із способів, через який може виникнути ця помилка: rhs формули є перепараметризованим, таким чином, що зміна двох параметрів у тандемі дає однакове пристосування до даних. Я не бачу, як це правда для вашої моделі, але, можливо, це так.

У будь-якому випадку ви можете написати власну цільову функцію і мінімізувати її. Наступна функція дає помилку у квадраті для точок даних (x, y) та певне значення параметрів (дивна структура аргументу функції - це врахування того, як optimпрацює):

sqerror <- function (par, x, y) {
  sum((y - changePoint(x, par[1], par[2], par[3], par[4]))^2)
}

Тоді ми кажемо:

optim(par = c(50, 0, 2, 48), fn = sqerror, x = x, y = data)

І дивіться:

$par
[1] 54.53436800 -0.09283594  2.07356459 48.00000006

Зауважте, що для моїх підроблених даних ( x <- 40:60; data <- changePoint(x, 50, 0, 2, 48) + rnorm(21, 0, 0.5)) існує багато локальних максимумів залежно від початкових значень параметрів, які ви даєте. Я вважаю, що якщо ви хочете серйозно поставитися до цього, ви зателефонували б оптимізатору багато разів із випадковими початковими параметрами та вивчили розподіл результатів.

Просто хотів додати, що ви можете це зробити з багатьма іншими пакетами. Якщо ви хочете отримати оцінку невизначеності навколо точки зміни (щось не можна зробити), спробуйте mcpпакет.

# Simulate the data
df = data.frame(x = 1:100)
df$y = c(rnorm(20, 50, 5), rnorm(80, 50 + 1.5*(df$x[21:100] - 20), 5))

# Fit the model
model = list(
  y ~ 1,  # Intercept
  ~ 0 + x  # Joined slope
)
library(mcp)
fit = mcp(model, df)

Побудуємо його за допомогою інтервалу прогнозування (зелена лінія). Синя щільність - це задній розподіл для місця зміни точки:

# Plot it
plot(fit, q_predict = T)

Ви можете оглянути окремі параметри більш детально, використовуючи plot_pars(fit)та summary(fit).