كيفية رسم اثنين من المدرج الإحصائي معا في R؟




plot histogram (6)

أنا أستخدم R ولدي إطارين البيانات: الجزر والخيار. يحتوي كل إطار بيانات على عمود رقمي واحد يسرد طول جميع الجزر المقاسة (إجمالي: 100 كيلو جزر) والخيار (الإجمالي: 50 كيلو خيار).

أود أن أرسم اثنين من المدرج التكراري - طول الجزرة وأطوال الخيار - على نفس المؤامرة. أنها تتداخل ، لذلك أعتقد أنني بحاجة أيضا إلى بعض الشفافية. أحتاج أيضًا إلى استخدام الترددات النسبية وليس الأرقام المطلقة لأن عدد المثيلات في كل مجموعة مختلف.

شيء من هذا القبيل سيكون لطيفًا لكنني لا أفهم كيفية إنشاءه من الجدولين:


Dirk Eddelbuettel: الفكرة الأساسية ممتازة ولكن يمكن تحسين الكود كما هو موضح. [يستغرق وقتًا طويلاً للإيضاح ، ومن هنا جاءت إجابة منفصلة وليس تعليقًا.]

ترسم الدالة hist() افتراضيًا المؤامرات ، لذا يجب إضافة خيار plot=FALSE . وعلاوة على ذلك ، فمن الواضح أن إنشاء مساحة الأرض من خلال plot(0,0,type="n",...) المكالمة التي يمكنك إضافة تسميات المحور ، عنوان قطعة الخ. وأخيرا ، أود أن أذكر أن يمكن للمرء أيضًا استخدام التظليل للتمييز بين المدرجين التوضيحيين. هنا هو الرمز:

set.seed(42)
p1 <- hist(rnorm(500,4),plot=FALSE)
p2 <- hist(rnorm(500,6),plot=FALSE)
plot(0,0,type="n",xlim=c(0,10),ylim=c(0,100),xlab="x",ylab="freq",main="Two histograms")
plot(p1,col="green",density=10,angle=135,add=TRUE)
plot(p2,col="blue",density=10,angle=45,add=TRUE)

وهنا النتيجة (جزء كبير جدا بسبب RStudio :-)):


إليك وظيفة كتبت كتبتها تستخدم شفافية زائفة لتمثيل التكرارات التراكبية

plotOverlappingHist <- function(a, b, colors=c("white","gray20","gray50"),
                                breaks=NULL, xlim=NULL, ylim=NULL){

  ahist=NULL
  bhist=NULL

  if(!(is.null(breaks))){
    ahist=hist(a,breaks=breaks,plot=F)
    bhist=hist(b,breaks=breaks,plot=F)
  } else {
    ahist=hist(a,plot=F)
    bhist=hist(b,plot=F)

    dist = ahist$breaks[2]-ahist$breaks[1]
    breaks = seq(min(ahist$breaks,bhist$breaks),max(ahist$breaks,bhist$breaks),dist)

    ahist=hist(a,breaks=breaks,plot=F)
    bhist=hist(b,breaks=breaks,plot=F)
  }

  if(is.null(xlim)){
    xlim = c(min(ahist$breaks,bhist$breaks),max(ahist$breaks,bhist$breaks))
  }

  if(is.null(ylim)){
    ylim = c(0,max(ahist$counts,bhist$counts))
  }

  overlap = ahist
  for(i in 1:length(overlap$counts)){
    if(ahist$counts[i] > 0 & bhist$counts[i] > 0){
      overlap$counts[i] = min(ahist$counts[i],bhist$counts[i])
    } else {
      overlap$counts[i] = 0
    }
  }

  plot(ahist, xlim=xlim, ylim=ylim, col=colors[1])
  plot(bhist, xlim=xlim, ylim=ylim, col=colors[2], add=T)
  plot(overlap, xlim=xlim, ylim=ylim, col=colors[3], add=T)
}

إليك طريقة أخرى للقيام بذلك باستخدام دعم R للألوان الشفافة

a=rnorm(1000, 3, 1)
b=rnorm(1000, 6, 1)
hist(a, xlim=c(0,10), col="red")
hist(b, add=T, col=rgb(0, 1, 0, 0.5) )

النتائج في نهاية المطاف تبحث شيء من هذا القبيل:


توجد إجابات جميلة بالفعل ، لكنني فكرت في إضافة هذا. تبدو جيدة بالنسبة لي. (نسخ أرقام عشوائية من @ ديرك). هناك حاجة إلى library(scales)

set.seed(42)
hist(rnorm(500,4),xlim=c(0,10),col='skyblue',border=F)
hist(rnorm(500,6),add=T,col=scales::alpha('red',.5),border=F)

النتيجه هي...

تحديث: قد تكون هذه الوظيفة المتداخلة مفيدة أيضًا للبعض.

hist0 <- function(...,col='skyblue',border=T) hist(...,col=col,border=border) 

أشعر أن النتيجة من hist0 هي أجمل أن ننظر من hist

hist2 <- function(var1, var2,name1='',name2='',
              breaks = min(max(length(var1), length(var2)),20), 
              main0 = "", alpha0 = 0.5,grey=0,border=F,...) {    

library(scales)
  colh <- c(rgb(0, 1, 0, alpha0), rgb(1, 0, 0, alpha0))
  if(grey) colh <- c(alpha(grey(0.1,alpha0)), alpha(grey(0.9,alpha0)))

  max0 = max(var1, var2)
  min0 = min(var1, var2)

  den1_max <- hist(var1, breaks = breaks, plot = F)$density %>% max
  den2_max <- hist(var2, breaks = breaks, plot = F)$density %>% max
  den_max <- max(den2_max, den1_max)*1.2
  var1 %>% hist0(xlim = c(min0 , max0) , breaks = breaks,
                 freq = F, col = colh[1], ylim = c(0, den_max), main = main0,border=border,...)
  var2 %>% hist0(xlim = c(min0 , max0),  breaks = breaks,
                 freq = F, col = colh[2], ylim = c(0, den_max), add = T,border=border,...)
  legend(min0,den_max, legend = c(
    ifelse(nchar(name1)==0,substitute(var1) %>% deparse,name1),
    ifelse(nchar(name2)==0,substitute(var2) %>% deparse,name2),
    "Overlap"), fill = c('white','white', colh[1]), bty = "n", cex=1,ncol=3)

  legend(min0,den_max, legend = c(
    ifelse(nchar(name1)==0,substitute(var1) %>% deparse,name1),
    ifelse(nchar(name2)==0,substitute(var2) %>% deparse,name2),
    "Overlap"), fill = c(colh, colh[2]), bty = "n", cex=1,ncol=3) }

نتائج

par(mar=c(3, 4, 3, 2) + 0.1) 
set.seed(100) 
hist2(rnorm(10000,2),rnorm(10000,3),breaks = 50)

هو


في ما يلي مثال لكيفية تنفيذ ذلك في الرسومات R "الكلاسيكية":

## generate some random data
carrotLengths <- rnorm(1000,15,5)
cucumberLengths <- rnorm(200,20,7)
## calculate the histograms - don't plot yet
histCarrot <- hist(carrotLengths,plot = FALSE)
histCucumber <- hist(cucumberLengths,plot = FALSE)
## calculate the range of the graph
xlim <- range(histCucumber$breaks,histCarrot$breaks)
ylim <- range(0,histCucumber$density,
              histCarrot$density)
## plot the first graph
plot(histCarrot,xlim = xlim, ylim = ylim,
     col = rgb(1,0,0,0.4),xlab = 'Lengths',
     freq = FALSE, ## relative, not absolute frequency
     main = 'Distribution of carrots and cucumbers')
## plot the second graph on top of this
opar <- par(new = FALSE)
plot(histCucumber,xlim = xlim, ylim = ylim,
     xaxt = 'n', yaxt = 'n', ## don't add axes
     col = rgb(0,0,1,0.4), add = TRUE,
     freq = FALSE) ## relative, not absolute frequency
## add a legend in the corner
legend('topleft',c('Carrots','Cucumbers'),
       fill = rgb(1:0,0,0:1,0.4), bty = 'n',
       border = NA)
par(opar)

المشكلة الوحيدة في هذا هو أنه يبدو أفضل بكثير إذا تمت محاذاة فواصل المدرج التكراري ، والتي قد يتعين إجراؤها يدويًا (في الوسيطات التي تم تمريرها hist ).


هنا حل أبسط حتى باستخدام الرسومات الأساسية ومزج ألفا (الذي لا يعمل على جميع أجهزة الرسومات):

set.seed(42)
p1 <- hist(rnorm(500,4))                     # centered at 4
p2 <- hist(rnorm(500,6))                     # centered at 6
plot( p1, col=rgb(0,0,1,1/4), xlim=c(0,10))  # first histogram
plot( p2, col=rgb(1,0,0,1/4), xlim=c(0,10), add=T)  # second

المفتاح هو أن الألوان شبه شفافة.

تعديل ، بعد أكثر من عامين : نظرًا لأن هذا قد حصل للتو على تغيير ، فإنني قد أضِف صورة مرئية لما ينتج عن الشفرة لأن مزج ألفا مفيد جدًا:


هنا هو الإصدار مثل ggplot2 واحد أعطيته فقط في القاعدة R. أنا نسخ بعض من @ nullglob.

توليد البيانات

carrots <- rnorm(100000,5,2)
cukes <- rnorm(50000,7,2.5)

لست بحاجة إلى وضعها في إطار بيانات مثل ggplot2. العيب في هذه الطريقة هو أنه يجب عليك كتابة الكثير من تفاصيل المؤامرة. الميزة هي أن لديك السيطرة على مزيد من التفاصيل عن هذه المؤامرة.

## calculate the density - don't plot yet
densCarrot <- density(carrots)
densCuke <- density(cukes)
## calculate the range of the graph
xlim <- range(densCuke$x,densCarrot$x)
ylim <- range(0,densCuke$y, densCarrot$y)
#pick the colours
carrotCol <- rgb(1,0,0,0.2)
cukeCol <- rgb(0,0,1,0.2)
## plot the carrots and set up most of the plot parameters
plot(densCarrot, xlim = xlim, ylim = ylim, xlab = 'Lengths',
     main = 'Distribution of carrots and cucumbers', 
     panel.first = grid())
#put our density plots in
polygon(densCarrot, density = -1, col = carrotCol)
polygon(densCuke, density = -1, col = cukeCol)
## add a legend in the corner
legend('topleft',c('Carrots','Cucumbers'),
       fill = c(carrotCol, cukeCol), bty = 'n',
       border = NA)





histogram