พล็อตเส้นการถดถอยแบบต่อเนื่อง

มีวิธีการพล็อตบรรทัดการถดถอยของตัวแบบทีละชิ้นเช่นนี้นอกเหนือจากการใช้linesเพื่อพล็อตแต่ละเซ็กเมนต์แยกจากกันหรือใช้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

ขอบคุณ.

วิธีเดียวที่ฉันรู้วิธีการทำเช่นนี้ได้อย่างง่ายดายคือการทำนายจากตัวแบบในช่วงsqftและวางแผนการคาดการณ์ ไม่มีวิธีทั่วไปที่มีablineหรือคล้ายกัน คุณอาจดูแพ็คเกจที่แบ่งกลุ่มซึ่งจะพอดีกับโมเดลเหล่านี้และจัดเตรียมโครงสร้างพื้นฐานการพล็อตสำหรับคุณ

ทำสิ่งนี้ผ่านการทำนายและกราฟิคพื้นฐาน ก่อนอื่นข้อมูลจำลองบางตัว:

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)

พอดีกับรูปแบบ:

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

สร้างข้อมูลบางอย่างเพื่อทำนายและทำนาย:

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

เขียนเส้นการถดถอย:

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)

คุณสามารถเขียนโค้ดนี้เป็นฟังก์ชั่นง่าย ๆ - คุณต้องการเพียงขั้นตอนในโค้ดสองชิ้นก่อนหน้าซึ่งคุณสามารถใช้แทน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)
}

แล้ว:

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)

ผ่านแพ็คเกจที่แบ่งกลุ่ม

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

ด้วยข้อมูลเหล่านี้ไม่ได้ประมาณค่าเบรกพอยต์ที่mean(sqft)แต่plotและlinesวิธีการในแพคเกจนั้นอาจช่วยให้คุณสามารถใช้งานทั่วไปมากกว่าที่myablineจะทำงานนี้ให้กับคุณจากlm()โมเดลที่ติดตั้ง

แก้ไข:หากคุณต้องการแบ่งกลุ่มเพื่อประมาณตำแหน่งของเบรกพอยต์ให้ตั้งค่า'psi'อาร์กิวเมนต์เป็นNA:

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

จากนั้นsegmentedจะพยายามK = 10quantiles ของsqftกับKการตั้งในและที่เริ่มต้นที่seg.control() 10ดู?seg.controlเพิ่มเติม