Modifier l'analyse des points à l'aide de R nls ()

J'essaye d'implémenter une analyse de "point de changement", ou une régression polyphasée en utilisant nls()dans R.

Voici quelques fausses données que j'ai faites . La formule que je veux utiliser pour ajuster les données est la suivante:

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

Ce que cela est censé faire, c'est ajuster les données jusqu'à un certain point avec une certaine interception et pente ( $\beta_0$ et $\beta_1$ ), puis, après une certaine valeur x ( $\delta$ ), augmenter la pente de $\beta_2$ . C'est de cela qu'il s'agit. Avant le point $\delta$ , il sera égal à 0 et $\beta_2$ sera remis à zéro.

Alors, voici ma fonction pour ce faire:

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

Et j'essaie d'adapter le modèle de cette façon

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

J'ai choisi ces paramètres de départ, parce que je sais que ce sont les paramètres de départ, parce que j'ai inventé les données.

Cependant, j'obtiens cette erreur:

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

Est-ce que je viens de faire des données malheureuses? J'ai d'abord essayé d'ajuster cela sur des données réelles, et j'obtenais la même erreur, et j'ai juste pensé que mes paramètres de démarrage initiaux n'étaient pas assez bons.

(Au début, je pensais que cela pourrait être un problème résultant du fait qu'il maxn'est pas vectorisé, mais ce n'est pas vrai. Cela rend difficile de travailler avec changePoint, d'où la modification suivante:

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

Ce message de la liste de diffusion R-help décrit une façon dont cette erreur peut se produire: le rhs de la formule est sur-paramétré, de sorte que la modification de deux paramètres en tandem donne le même ajustement aux données. Je ne vois pas comment cela est vrai pour votre modèle, mais c'est peut-être le cas.

Dans tous les cas, vous pouvez écrire votre propre fonction objectif et la minimiser. La fonction suivante donne l'erreur quadratique pour les points de données (x, y) et une certaine valeur des paramètres (la structure d'argument étrange de la fonction est de rendre compte du optimfonctionnement):

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

Ensuite, nous disons:

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

Et voyez:

$par
[1] 54.53436800 -0.09283594  2.07356459 48.00000006

Notez que pour mes fausses données ( x <- 40:60; data <- changePoint(x, 50, 0, 2, 48) + rnorm(21, 0, 0.5)), il y a beaucoup de maxima locaux en fonction des valeurs de paramètres initiales que vous donnez. Je suppose que si vous voulez prendre cela au sérieux, vous appellerez l'optimiseur plusieurs fois avec des paramètres initiaux aléatoires et examinerez la distribution des résultats.

Je voulais juste ajouter que vous pouvez le faire avec de nombreux autres packages. Si vous souhaitez obtenir une estimation de l'incertitude autour du point de changement (quelque chose que nls ne peut pas faire), essayez le mcppackage.

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

Tracons-le avec un intervalle de prédiction (ligne verte). La densité bleue est la distribution postérieure de l'emplacement du point de changement:

# Plot it
plot(fit, q_predict = T)

Vous pouvez inspecter les paramètres individuels plus en détail à l'aide de plot_pars(fit)et summary(fit).