R의 nls ()를 사용한 변화 점 분석

"change point"분석 또는 nls()R에서 다상 회귀 분석을 구현하려고합니다 .

여기 내가 만든 가짜 데이터가 있습니다. 데이터를 맞추기 위해 사용하려는 공식은 다음과 같습니다.

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

이것이해야 할 일은 특정 절편과 기울기 ( $\beta_0$ 및 $\beta_1$ ) 로 특정 지점까지 데이터를 맞추고 특정 x 값 ( $\delta$ ) 후에 \ beta_2만큼 기울기를 늘리는 것$\beta_2$ 입니다. 그것이 최대의 문제입니다. $\delta$ 포인트 전에는 0이되고 $\beta_2$ 는 0이됩니다.

그래서, 이것을하는 내 기능은 다음과 같습니다.

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

방금 불행한 데이터를 만들었습니까? 나는 이것을 실제 데이터에 먼저 맞추려고 시도했는데 같은 오류가 발생했고 초기 시작 매개 변수가 충분하지 않다는 것을 알았습니다.

(첫번째 I에서이 사실로 인한 문제가 될 수 있다고 생각 max벡터화되지 않은,하지만 그건 사실이 아니에요 그것은. 않는다 그것을 Changepoint는, 어찌하여 다음과 같은 수정 작업 할 고통을합니다

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

이 R-help 메일 링리스트 포스트 는이 오류가 발생할 수있는 한 가지 방법을 설명합니다. 두 매개 변수를 동시에 변경하면 공식의 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))의 경우 초기 매개 변수 값에 따라 많은 로컬 최대 값이 있습니다. 나는 이것을 진지하게 원한다면 임의의 초기 매개 변수를 사용하여 옵티 마이저를 여러 번 호출하고 결과 분포를 검사한다고 가정합니다.

다른 많은 패키지에서도이 작업을 수행 할 수 있다고 덧붙이고 싶었습니다. 변경점 주위의 불확실성 추정치를 얻으려면 (nls가 할 수없는 것) 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).