Merencanakan garis regresi satu demi satu

Apakah ada cara memplot garis regresi dari model sambungan seperti ini, selain menggunakan linesuntuk memplot setiap segmen secara terpisah, atau menggunakan geom_smooth(aes(group=Ind), method="lm", fill=FALSE)?

m.sqft <- mean(sqft)
model <- lm(price~sqft+I((sqft-m.sqft)*Ind))
# sqft, price: continuous variables, Ind: if sqft>mean(sqft) then 1 else 0

plot(sqft,price)
abline(reg = model)
Warning message:
In abline(reg = model) :
  only using the first two of 3regression coefficients

Terima kasih.

Satu-satunya cara saya tahu bagaimana melakukan ini dengan mudah adalah dengan memprediksi dari model di seluruh rentang sqftdan merencanakan prediksi. Tidak ada cara umum dengan ablineatau serupa. Anda juga dapat melihat paket tersegmentasi yang sesuai dengan model ini dan menyediakan infrastruktur merencanakan untuk Anda.

Melakukan ini melalui prediksi dan gambar dasar. Pertama, beberapa data dummy:

set.seed(1)
sqft <- runif(100)
sqft <- ifelse((tmp <- sqft > mean(sqft)), 1, 0) + rnorm(100, sd = 0.5)
price <- 2 + 2.5 * sqft
price <- ifelse(tmp, price, 0) + rnorm(100, sd = 0.6)
DF <- data.frame(sqft = sqft, price = price,
                 Ind = ifelse(sqft > mean(sqft), 1, 0))
rm(price, sqft)
plot(price ~ sqft, data = DF)

Sesuai dengan model:

mod <- lm(price~sqft+I((sqft-mean(sqft))*Ind), data = DF)

Hasilkan beberapa data untuk memprediksi dan memprediksi:

m.sqft <- with(DF, mean(sqft))
pDF <- with(DF, data.frame(sqft = seq(min(sqft), max(sqft), length = 200)))
pDF <- within(pDF, Ind <- ifelse(sqft > m.sqft, 1, 0))
pDF <- within(pDF, price <- predict(mod, newdata = pDF))

Plot garis regresi:

ylim <- range(pDF$price, DF$price)
xlim <- range(pDF$sqft, DF$sqft)
plot(price ~ sqft, data = DF, ylim = ylim, xlim = xlim)
lines(price ~ sqft, data = pDF, subset = Ind > 0, col = "red", lwd = 2)
lines(price ~ sqft, data = pDF, subset = Ind < 1, col = "red", lwd = 2)

Anda bisa mengkodekannya menjadi fungsi sederhana - Anda hanya perlu langkah-langkah di dua bidak kode sebelumnya - yang bisa Anda gunakan sebagai pengganti abline:

myabline <- function(model, data, ...) {
    m.sqft <- with(data, mean(sqft))
    pDF <- with(data, data.frame(sqft = seq(min(sqft), max(sqft),
                                            length = 200)))
    pDF <- within(pDF, Ind <- ifelse(sqft > m.sqft, 1, 0))
    pDF <- within(pDF, price <- predict(mod, newdata = pDF))
    lines(price ~ sqft, data = pDF, subset = Ind > 0, ...)
    lines(price ~ sqft, data = pDF, subset = Ind < 1, ...)
    invisible(model)
}

Kemudian:

ylim <- range(pDF$price, DF$price)
xlim <- range(pDF$sqft, DF$sqft)
plot(price ~ sqft, data = DF, ylim = ylim, xlim = xlim)
myabline(mod, DF, col = "red", lwd = 2)

Melalui paket tersegmentasi

require(segmented)
mod2 <- lm(price ~ sqft, data = DF)
mod.s <- segmented(mod2, seg.Z = ~ sqft, psi = 0.5,
                   control = seg.control(stop.if.error = FALSE))
plot(price ~ sqft, data = DF)
plot(mod.s, add = TRUE)
lines(mod.s, col = "red")

Dengan data ini ia tidak memperkirakan breakpoint mean(sqft), tetapi metode plotdan linesdalam paket itu mungkin membantu Anda menerapkan sesuatu yang lebih umum daripada myablinemelakukan pekerjaan ini untuk Anda langsung dari lm()model yang sesuai .

Sunting: Jika Anda ingin disegmentasi untuk memperkirakan lokasi breakpoint, maka atur 'psi'argumen ke NA:

mod.s <- segmented(mod2, seg.Z = ~ sqft, psi = NA,
                   control = seg.control(stop.if.error = FALSE))

Kemudian segmentedakan mencoba K = 10kuantil dari sqft, dengan Kdiset di seg.control()dan yang defaultnya 10. Lihat ?seg.controllebih lanjut.