Cara memuluskan data dan memaksakan monotonitas

Saya memiliki beberapa data yang ingin saya smoothkan sehingga poin yang dihaluskan menurun secara monoton. Data saya menurun tajam dan kemudian mulai naik. Berikut ini contoh menggunakan 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()

Apa teknik smoothing yang baik yang bisa saya gunakan? Juga, alangkah baiknya jika saya bisa memaksa titik 1 yang dihaluskan agar mendekati titik yang saya amati.

Anda dapat melakukan ini menggunakan splines yang dihukum dengan batasan monotonisitas melalui mono.con()dan pcls()fungsi dalam paket mgcv . Ada sedikit yang perlu dilakukan karena fungsi-fungsi ini tidak ramah pengguna gam(), tetapi langkah-langkahnya ditunjukkan di bawah ini, sebagian besar didasarkan pada contoh dari ?pcls, dimodifikasi agar sesuai dengan data sampel yang Anda berikan:

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!

Sekarang kita perlu mengisi objek yang diteruskan ke pcls()berisi rincian model dibatasi hukuman yang ingin kita muat

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

Sekarang kita akhirnya bisa melakukan pemasangan

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

pberisi vektor koefisien untuk fungsi dasar yang berhubungan dengan spline. Untuk memvisualisasikan spline yang dipasang, kita dapat memprediksi dari model di 100 lokasi pada rentang x. Kami melakukan 100 nilai untuk mendapatkan garis halus yang bagus di plot.

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

Untuk menghasilkan nilai-nilai prediksi yang kami gunakan Predict.matrix(), yang menghasilkan matriks sehingga ketika banyak dengan koefisien pmenghasilkan nilai prediksi dari model yang dipasang:

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

Ini menghasilkan:

Saya akan menyerahkan kepada Anda untuk mendapatkan data ke dalam formulir yang rapi untuk diplot dengan ggplot ...

Anda dapat memaksakan kecocokan yang lebih dekat (untuk menjawab sebagian pertanyaan Anda tentang memiliki yang lebih halus cocok dengan titik data pertama) dengan meningkatkan dimensi fungsi dasar x. Misalnya, pengaturan ksama dengan 8( k <- 8) dan jalankan kembali kode di atas yang kita dapatkan

Anda tidak dapat mendorong klebih tinggi untuk data ini, dan Anda harus berhati-hati tentang pemasangan yang berlebihan; semua pcls()lakukan adalah menyelesaikan masalah kuadrat terkecil yang diberikan kendala dan fungsi dasar yang disediakan, itu tidak melakukan pemilihan kelancaran untuk Anda - bukan yang saya tahu ...)

Jika Anda ingin interpolasi, maka lihat fungsi dasar R ?splinefunyang memiliki spline Hermite dan splines kubik dengan kendala monotonik. Namun dalam hal ini Anda tidak dapat menggunakan ini karena datanya tidak sepenuhnya monoton.

Paket penipuan baru-baru ini oleh Natalya Pya dan berdasarkan pada makalah "Bentuk model aditif terbatas" oleh Pya & Wood (2015) dapat membuat bagian dari proses yang disebutkan dalam jawaban luar biasa Gavin menjadi lebih mudah.

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

Ada sejumlah fungsi bs yang dapat Anda gunakan - di atas saya menggunakan mpd untuk "monotonik penurunan P-spline" tetapi juga memiliki fungsi yang menegakkan cembung atau cekung baik secara terpisah atau bersamaan dengan kendala monotonik.