Comment lisser les données et forcer la monotonie

J'ai quelques données que je voudrais lisser pour que les points lissés diminuent de façon monotone. Mes données diminuent fortement puis commencent à se stabiliser. Voici un exemple utilisant R

df <- data.frame(x=1:10, y=c(100,41,22,10,6,7,2,1,3,1))
ggplot(df, aes(x=x, y=y))+geom_line()

Quelle bonne technique de lissage pourrais-je utiliser? De plus, ce serait bien si je pouvais forcer le 1er point lissé à être proche de mon point observé.

Vous pouvez le faire en utilisant des splines pénalisées avec des contraintes de monotonie via les fonctions mono.con()et pcls()dans le package mgcv . Il y a un peu à faire car ces fonctions ne sont pas aussi conviviales que gam(), mais les étapes sont indiquées ci-dessous, basées principalement sur l'exemple de ?pcls, modifiées pour s'adapter aux exemples de données que vous avez donnés:

df <- data.frame(x=1:10, y=c(100,41,22,10,6,7,2,1,3,1))

## Set up the size of the basis functions/number of knots
k <- 5
## This fits the unconstrained model but gets us smoothness parameters that
## that we will need later
unc <- gam(y ~ s(x, k = k, bs = "cr"), data = df)

## This creates the cubic spline basis functions of `x`
## It returns an object containing the penalty matrix for the spline
## among other things; see ?smooth.construct for description of each
## element in the returned object
sm <- smoothCon(s(x, k = k, bs = "cr"), df, knots = NULL)[[1]]

## This gets the constraint matrix and constraint vector that imposes
## linear constraints to enforce montonicity on a cubic regression spline
## the key thing you need to change is `up`.
## `up = TRUE` == increasing function
## `up = FALSE` == decreasing function (as per your example)
## `xp` is a vector of knot locations that we get back from smoothCon
F <- mono.con(sm$xp, up = FALSE)   # get constraints: up = FALSE == Decreasing constraint!

Maintenant, nous devons remplir l'objet qui est passé à pcls()contenant les détails du modèle contraint pénalisé que nous voulons adapter

## Fill in G, the object pcsl needs to fit; this is just what `pcls` says it needs:
## X is the model matrix (of the basis functions)
## C is the identifiability constraints - no constraints needed here
##   for the single smooth
## sp are the smoothness parameters from the unconstrained GAM
## p/xp are the knot locations again, but negated for a decreasing function
## y is the response data
## w are weights and this is fancy code for a vector of 1s of length(y)
G <- list(X = sm$X, C = matrix(0,0,0), sp = unc$sp,
          p = -sm$xp, # note the - here! This is for decreasing fits!
      y = df$y,
          w = df$y*0+1)
G$Ain <- F$A    # the monotonicity constraint matrix
G$bin <- F$b    # the monotonicity constraint vector, both from mono.con
G$S <- sm$S     # the penalty matrix for the cubic spline
G$off <- 0      # location of offsets in the penalty matrix

Maintenant, nous pouvons enfin faire le montage

## Do the constrained fit 
p <- pcls(G)  # fit spline (using s.p. from unconstrained fit)

pcontient un vecteur de coefficients pour les fonctions de base correspondant à la spline. Pour visualiser la spline ajustée, nous pouvons prédire à partir du modèle à 100 emplacements sur la plage de x. Nous faisons 100 valeurs afin d'obtenir une belle ligne lisse sur l'intrigue.

## predict at 100 locations over range of x - get a smooth line on the plot
newx <- with(df, data.frame(x = seq(min(x), max(x), length = 100)))

Pour générer des valeurs prédites que nous utilisons Predict.matrix(), qui génère une matrice telle que lorsque plusieurs par coefficients pproduisent des valeurs prédites à partir du modèle ajusté:

fv <- Predict.matrix(sm, newx) %*% p
newx <- transform(newx, yhat = fv[,1])

plot(y ~ x, data = df, pch = 16)
lines(yhat ~ x, data = newx, col = "red")

Cela produit:

Je vous laisse le soin de mettre les données sous une forme ordonnée pour tracer avec ggplot ...

Vous pouvez forcer un ajustement plus étroit (pour répondre partiellement à votre question sur l'ajustement plus fluide du premier point de données) en augmentant la dimension de la fonction de base de x. Par exemple, en définissant kégal à 8( k <- 8) et en réexécutant le code ci-dessus, nous obtenons

Vous ne pouvez pas pousser kbeaucoup plus haut pour ces données, et vous devez faire attention au sur-ajustement; tout ce qu'il pcls()y a à faire est de résoudre le problème des moindres carrés pénalisés étant donné les contraintes et les fonctions de base fournies, il n'effectue pas de sélection de lissage pour vous - pas que je sache ...)

Si vous voulez une interpolation, alors voyez la fonction R de base ?splinefunqui a des splines Hermite et des splines cubiques avec des contraintes de monotonie. Dans ce cas, vous ne pouvez toutefois pas l'utiliser, car les données ne sont pas strictement monotones.

Le récent paquet d'arnaques de Natalya Pya et basé sur le document "Shape constrained additive models" de Pya & Wood (2015) peut faciliter une partie du processus mentionné dans l'excellente réponse de Gavin.

library(scam)
con <- scam(y ~ s(x, k = k, bs = "mpd"), data = df)
plot(con)

Il existe un certain nombre de fonctions bs que vous pouvez utiliser - dans ce qui précède, j'ai utilisé mpd pour "monotonique décroissante P-spline", mais il a également des fonctions qui imposent la convexité ou la concavité séparément ou à côté des contraintes monotones.