Puede hacerlo utilizando splines penalizadas con restricciones de monotonicidad a través de las funciones mono.con()
y pcls()
del paquete mgcv . Hay un poco de juego por hacer porque estas funciones no son tan fáciles de usar gam()
, pero los pasos se muestran a continuación, basados principalmente en el ejemplo de ?pcls
, modificado para adaptarse a los datos de muestra que proporcionó:
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!
Ahora necesitamos completar el objeto que se pasa a pcls()
contener detalles del modelo restringido penalizado que queremos ajustar
## 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
Ahora finalmente podemos hacer el ajuste
## Do the constrained fit
p <- pcls(G) # fit spline (using s.p. from unconstrained fit)
p
contiene un vector de coeficientes para las funciones básicas correspondientes a la spline. Para visualizar la spline ajustada, podemos predecir a partir del modelo en 100 ubicaciones en el rango de x. Hacemos 100 valores para obtener una buena línea suave en la trama.
## 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)))
Para generar valores pronosticados, utilizamos Predict.matrix()
, que genera una matriz tal que cuando múltiples coeficientes p
rinden valores pronosticados del modelo ajustado:
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")
Esto produce:
Te lo dejaré a ti para obtener los datos en un formulario ordenado para trazar con ggplot ...
Puede forzar un ajuste más cercano (para responder parcialmente a su pregunta sobre cómo hacer que el ajuste más suave se ajuste al primer punto de datos) aumentando la dimensión de la función base de x
. Por ejemplo, al establecer k
igual a 8
( k <- 8
) y volver a ejecutar el código anterior, obtenemos
No puede presionar k
mucho más por estos datos, y debe tener cuidado con el ajuste excesivo; todospcls()
está haciendo es resolver el problema de mínimos cuadrados penalizados dadas las restricciones y las funciones básicas proporcionadas, no está realizando una selección de suavidad para usted, no que yo sepa ...)
Si desea la interpolación, vea la función base R ?splinefun
que tiene splines Hermite y splines cúbicas con restricciones de monotonía. Sin embargo, en este caso no puede usar esto ya que los datos no son estrictamente monótonos.
plot(y~x,data=df); f=fitted( glm( y~ns(x,df=4), data=df,family=quasipoisson)); lines(df$x,f)