พล็อตการถดถอยเชิงซ้อนใน R


10

ฉันต้องการวาดกราฟิกที่ซับซ้อนสำหรับการวิเคราะห์ข้อมูลภาพ ฉันมี 2 ตัวแปรและกรณีจำนวนมาก (> 1,000) ตัวอย่างเช่น (หมายเลขคือ 100 ถ้าทำให้การกระจายน้อยลง "ปกติ"):

x <- rnorm(100,mean=95,sd=50)
y <- rnorm(100,mean=35,sd=20)
d <- data.frame(x=x,y=y)

1) ฉันต้องการพล็อตข้อมูลดิบที่มีขนาดพอยต์ซึ่งสอดคล้องกับความถี่สัมพัทธ์ของความบังเอิญดังนั้นจึงplot(x,y)ไม่ใช่ตัวเลือก - ฉันต้องการขนาดพอยต์ สิ่งที่ควรทำเพื่อให้บรรลุสิ่งนี้?

2) ในพล็อตเดียวกันฉันต้องพล็อตความมั่นใจช่วง 95% วงรีและบรรทัดที่แสดงถึงการเปลี่ยนแปลงของสหสัมพันธ์ (ไม่รู้วิธีตั้งชื่ออย่างถูกต้อง) - บางอย่างเช่นนี้:

library(corrgram)
corrgram(d, order=TRUE, lower.panel=panel.ellipse, upper.panel=panel.pts)

correlogramm

แต่มีกราฟทั้งสองที่หนึ่งพล็อต

3) ในที่สุดฉันต้องวาดโมเดลการถดถอยของ linar ที่เกิดขึ้นจากสิ่งเหล่านี้ทั้งหมด:

r<-lm(y~x, data=d)
abline(r,col=2,lwd=2)

แต่มีช่วงข้อผิดพลาด ... คล้ายกับ QQ-plot:

QQ พล็อต

แต่สำหรับข้อผิดพลาดที่เหมาะสมถ้าเป็นไปได้

ดังนั้นคำถามคือ:

วิธีการบรรลุทั้งหมดนี้ในกราฟเดียว?

คำตอบ:


29

ภาพด้านล่างดูเหมือนว่าคุณต้องการบรรลุหรือไม่

ป้อนคำอธิบายรูปภาพที่นี่

นี่คือรหัส R ที่ได้รับการอัพเดตตามความคิดเห็นของคุณ:

do.it <- function(df, type="confidence", ...) {
  require(ellipse)
  lm0 <- lm(y ~ x, data=df)
  xc <- with(df, xyTable(x, y))
  df.new <- data.frame(x=seq(min(df$x), max(df$x), 0.1))
  pred.ulb <- predict(lm0, df.new, interval=type)
  pred.lo <- predict(loess(y ~ x, data=df), df.new)
  plot(xc$x, xc$y, cex=xc$number*2/3, xlab="x", ylab="y", ...)
  abline(lm0, col="red")
  lines(df.new$x, pred.lo, col="green", lwd=1.5)
  lines(df.new$x, pred.ulb[,"lwr"], lty=2, col="red")
  lines(df.new$x, pred.ulb[,"upr"], lty=2, col="red")    
  lines(ellipse(cor(df$x, df$y), scale=c(sd(df$x),sd(df$y)), 
        centre=c(mean(df$x),mean(df$y))), lwd=1.5, col="green")
  invisible(lm0)
}

set.seed(101)
n <- 1000
x <- rnorm(n, mean=2)
y <- 1.5 + 0.4*x + rnorm(n)
df <- data.frame(x=x, y=y)

# take a bootstrap sample
df <- df[sample(nrow(df), nrow(df), rep=TRUE),]

do.it(df, pch=19, col=rgb(0,0,.7,.5))

และนี่คือรุ่นggplotized

ป้อนคำอธิบายรูปภาพที่นี่

ผลิตด้วยรหัสชิ้นส่วนต่อไปนี้:

xc <- with(df, xyTable(x, y))
df2 <- cbind.data.frame(x=xc$x, y=xc$y, n=xc$number)
df.ell <- as.data.frame(with(df, ellipse(cor(x, y), 
                                         scale=c(sd(x),sd(y)), 
                                         centre=c(mean(x),mean(y)))))
library(ggplot2)

ggplot(data=df2, aes(x=x, y=y)) + 
  geom_point(aes(size=n), alpha=.6) + 
  stat_smooth(data=df, method="loess", se=FALSE, color="green") + 
  stat_smooth(data=df, method="lm") +
  geom_path(data=df.ell, colour="green", size=1.2)

มันสามารถปรับแต่งเพิ่มได้อีกนิดโดยการเพิ่มดัชนีแบบจำลองเช่นระยะทางของ Cook ด้วยเอฟเฟกต์การแรเงาสี


1
@chl +1 กราฟที่ดีและรหัสย่อ
mpiktas

@mpiktas ขอบคุณ นี้ทำให้ฉันรู้ฉันไม่ได้ทำงานร่วมกับกลุ่มตัวอย่างที่เหมาะสมในความเป็นจริง :-)
CHL

df.new <- data.frame(x = seq(min(x), max(x), 0.1))s size is also strange (too small). Also tryed x,dflibrary(car) cr.plots(m0)

(x,y)car::dataEllipseellipse

2
@Tal การแปลความหมายของวงรีนั้นเหมือนกับใน corrgramแพคเกจ: มันแสดงขอบเขตความเชื่อมั่น 95% ที่เป็นคู่โดยสมมติว่าการแจกแจงปกติแบบ bivariate มีศูนย์กลางอยู่ที่ค่าเฉลี่ยและปรับขนาดโดย SD (x) และ SD (y) ฉันไม่ได้เป็นแฟนตัวยงของเรื่องนี้เมื่อใช้ในสแกตเตอร์ล็อต แต่ดู Murdoch & Chow, การแสดงกราฟิกของเมทริกซ์สหสัมพันธ์ขนาดใหญ่ , Am Stat (1996) 50: 178, หรือ Friendly, Corrgrams: Exploratory แสดงสำหรับเมทริกซ์สหสัมพันธ์ , Am Stat (2002) 56: 316
chl

2

สำหรับจุดที่ 1 เพียงใช้cexพารามิเตอร์ในการลงจุดเพื่อกำหนดขนาดพอยต์

ตัวอย่างเช่น

x = rnorm(100)
plot(x, pch=20, cex=abs(x))

การมีกราฟหลายกราฟในหนึ่งพล็อตใช้par(mfrow=c(numrows, numcols))เพื่อให้มีเลย์เอาต์ที่เว้นระยะเท่ากันหรือlayoutเพื่อให้ซับซ้อนมากขึ้น


1
+1 สำหรับเคล็ดลับเกี่ยวกับcexแต่ฉันคิดว่า OP ต้องการทุกสิ่งในพื้นที่การวางแผนเดียวกันไม่ใช่แยกกัน
chl

อ่า ... ตอนนี้ฉันเข้าใจคำถามแล้ว ถ้าอย่างนั้นเขาก็สามารถใช้curveหรือpointsวาดกราฟสามกราฟมากเกินไป)
โก้
โดยการใช้ไซต์ของเรา หมายความว่าคุณได้อ่านและทำความเข้าใจนโยบายคุกกี้และนโยบายความเป็นส่วนตัวของเราแล้ว
Licensed under cc by-sa 3.0 with attribution required.