आर में जटिल प्रतिगमन भूखंड

Question

मुझे दृश्य डेटा विश्लेषण के लिए एक जटिल ग्राफिक्स बनाने की आवश्यकता है। मेरे पास 2 चर हैं और बड़ी संख्या में मामले (> 1000) हैं। उदाहरण के लिए (संख्या 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)

लेकिन एक भूखंड पर दोनों रेखांकन के साथ।

3) अंत में, मैं इस सब के शीर्ष पर एक परिणामी लाइनर प्रतिगमन मॉडल तैयार करने की आवश्यकता है:

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

लेकिन त्रुटि सीमा के साथ ... QQ- प्लॉट पर कुछ इस तरह:

लेकिन फिटिंग त्रुटियों के लिए, यदि यह संभव है।

तो सवाल यह है:

एक ग्राफ पर यह सब कैसे प्राप्त करें?

Answer 1

क्या नीचे दी गई तस्वीर वैसी ही दिखती है जैसी आप हासिल करना चाहते हैं?

आपकी टिप्पणियों के बाद यहां अपडेट किया गया आर कोड है:

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)

यह एक रंग छायांकन प्रभाव के साथ कुक की दूरी जैसे मॉडल फिट सूचकांकों को जोड़कर थोड़ा और अनुकूलित किया जा सकता है।

Comments

@chl +1, अच्छा ग्राफ और लघु कोड।

— एमपिकटास

@mpiktas धन्यवाद यह मैं महसूस करने के लिए मैं सही नमूने के साथ काम नहीं किया, :-) वास्तव में नेतृत्व

— CHL

लगभग वही दिखता है जिसकी मुझे आवश्यकता है, लेकिन वास्तविक संख्याओं के साथ मुझे निम्नलिखित समस्याओं का सामना करना पड़ा: 1) df.new <- data.frame(x = seq(min(x), max(x), 0.1))बेहतर है। 2) दीर्घवृत्त 0 पर आहरित होता है; 0 स्थिति, जो सही नहीं है और यह s size is also strange (too small). Also tryed पुस्तकालय (कार) dataEllipse (df y, स्तर = 0.95: 1, lty = 2) `लेकिन यह सभी को गिरा देता है । 3) वक्र (जैसे कि कोरलोग्राम) गायब है। मैंने इसे कॉल करके लगभग पुन: पेश किया लेकिन डेटा की सीमा गलत है। पुन: पेश करने के लिए आपके बजाय मेरे कोड से पहली 2 पंक्तियों का उपयोग करें। $x, df$library(car) cr.plots(m0)

— यूरी पेट्रोव्स्की

@Yuriy ठीक है, मैं अपने कोड को अपडेट करूँगा (इस बीच कोई भी संपादन करने की आवश्यकता नहीं है), लेकिन मैं यह नहीं देख सकता कि हम आपके सेटिंग के साथ वास्तविक-मूल्यवान यादृच्छिक चर के साथ ओवरलैप कैसे प्राप्त कर सकते हैं ; यही कारण है कि मैं प्रतिस्थापन के साथ बूस्टरैप का उपयोग करता हूं (यह सुनिश्चित करता है कि मूल इकाइयों के ~ 2/3 मौजूद हैं)। पैकेज की तुलना में समान सुविधाएं प्रदान करता है , लेकिन शायद इसे अनुकूलित करना कम आसान है। मुझे लगता है कि सुपरिम्पोज्ड कर्व सिर्फ एक लूप है , इसलिए इसे जोड़ना मुश्किल नहीं है। $(x,y)$car::dataEllipseellipse

— CHL

@ ताल पैकेज की व्याख्या समान है corrgram: यह 95% युग्मक विश्वास क्षेत्र दिखाता है जो कि औसत पर केंद्रित एक द्विभाजित सामान्य वितरण को मानता है और SD (x) और SD (y) द्वारा स्केल किया जाता है। जब मैं स्कैप्लॉट में उपयोग किया जाता हूं, तो मैं इसका बहुत बड़ा प्रशंसक नहीं हूं। लेकिन मर्डोक एंड चाउ को देखें, बड़े सहसंबंध वाले मेट्रिसेस का एक चित्रमय प्रदर्शन , एम स्टेट (1996) 50: 178, या फ्रेंडली, कॉरग्राम: सहसंबंध मैट्रिक्स के लिए खोजपूर्ण डिस्प्ले , एम स्टेट (2002) 56: 316।

— CHL

Answer 2

बिंदु 1 के लिए बस cexबिंदु आकार निर्धारित करने के लिए प्लॉट पर पैरामीटर का उपयोग करें ।

उदाहरण के लिए

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

एक ही भूखंड में एक से अधिक ग्राफ़ का उपयोग par(mfrow=c(numrows, numcols))करने के लिए एक समान रूप से फ़्लेट लेआउट होना या layoutअधिक जटिल बनाना।

Comments

+1 टिप के बारे में cex, लेकिन मुझे लगता है कि ओपी एक ही प्लॉटिंग क्षेत्र पर सभी सामान चाहता है, अलग-अलग लोगों पर नहीं।

— chl

आह ... अब मैं प्रश्न समझ गया। ठीक है, तो वह बस का उपयोग कर सकते हैं curveया pointsतीन रेखांकन ओवरप्लोट कर सकते हैं;)

— निको