Rのnls（）を使用したポイント分析の変更

「変更点」分析、またはnls()R を使用したマルチフェーズ回帰を実装しようとしています。

ここに私が作ったいくつかの偽のデータがあります。データを近似するために使用する式は次のとおりです。

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

これは、特定の切片と勾配（および）で特定のポイントまでデータを近似し、特定のx値（）の後に、勾配をです。それが最大のことです。ポイントの前は、0に等しくなり、はゼロにされます。$\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-helpメーリングリストの投稿は、このエラーが発生する可能性のある1つの方法について説明しています。式のrhsがオーバーパラメーター化され、2つのパラメーターをタンデムに変更するとデータに同じ適合が得られます。それがあなたのモデルにどのように当てはまるかわかりませんが、多分そうです。

いずれの場合でも、独自の目的関数を記述して最小化できます。次の関数は、データポイント（x、y）とパラメーターの特定の値の2乗誤差を与えます（関数の奇妙な引数構造は、どのように機能するかを説明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)。