Come rendere più fluidi i dati e forzare la monotonicità

Ho alcuni dati che vorrei lisciare in modo che i punti levigati diminuiscano monotonicamente. I miei dati diminuiscono drasticamente e poi iniziano ad aumentare. Ecco un esempio usando 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()

Qual è una buona tecnica di lisciatura che potrei usare? Inoltre, sarebbe bello se potessi forzare il primo punto smussato ad essere vicino al mio punto osservato.

Puoi farlo usando spline penalizzate con vincoli di monotonicità tramite le funzioni mono.con()e pcls()nel pacchetto mgcv . C'è un po 'di confusione da fare perché queste funzioni non sono così facili da usare come gam(), ma i passaggi sono mostrati di seguito, basati principalmente sull'esempio di?pcls , modificato per adattarsi ai dati di esempio :

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!

Ora dobbiamo compilare l'oggetto a cui viene passato pcls() contenere i dettagli del modello vincolato penalizzato che vogliamo adattare

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

Ora possiamo finalmente fare il montaggio

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

pcontiene un vettore di coefficienti per le funzioni di base corrispondenti alla spline. Per visualizzare la spline adattata, possiamo prevedere dal modello in 100 posizioni nell'intervallo di x. Facciamo 100 valori in modo da ottenere una bella linea liscia sulla 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)))

Per generare i valori previsti utilizziamo Predict.matrix(), che genera una matrice tale che quando multiplo per coefficientip produce valori previsti dal modello adattato:

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

Questo produce:

Lascio a te il compito di mettere i dati in una forma ordinata per la stampa con ggplot ...

È possibile forzare un adattamento più ravvicinato (per rispondere parzialmente alla domanda sull'adattamento più uniforme al primo punto dati) aumentando la dimensione della funzione base di x. Ad esempio, impostando kuguale a 8( k <- 8) e rieseguendo il codice sopra otteniamo

Non puoi spingere k molto più in alto per questi dati e devi stare attento al troppo adattamento; tutto pcls()ciò che sta facendo è risolvere il problema dei minimi quadrati penalizzati dati i vincoli e le funzioni di base fornite, non sta eseguendo la selezione della scorrevolezza per te - non che io sappia di ...)

Se si desidera l'interpolazione, vedere la funzione R di base ?splinefunche ha spline di Hermite e spline cubiche con vincoli di monotonia. In questo caso, tuttavia, non è possibile utilizzarlo poiché i dati non sono strettamente monotonici.

Il recente pacchetto di truffe di Natalya Pya e basato sull'articolo "Modelli con additivi vincolati dalla forma" di Pya & Wood (2015) può rendere molto più semplice parte del processo menzionato nell'eccellente risposta di Gavin.

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

Esistono diverse funzioni bs che è possibile utilizzare: in precedenza ho usato mpd per "P-spline decrescente monotona" ma ha anche funzioni che impongono convessità o concavità separatamente o insieme ai vincoli monotonici.