Как построить две гистограммы вместе в R?

221

Я использую R, и у меня есть два кадра данных: морковь и огурцы. Каждый фрейм данных имеет один числовой столбец, в котором указана длина всех измеренных морковей (всего: 100 тысяч моркови) и огурцов (всего: 50 тысяч огурцов).

Я хочу построить две гистограммы - длина моркови и длина огурцов - на одном участке. Они пересекаются, так что, мне кажется, мне нужна прозрачность. Мне также нужно использовать относительные частоты, а не абсолютные числа, так как количество экземпляров в каждой группе различно.

что-то вроде этого было бы неплохо, но я не понимаю, как создать его из моих двух таблиц:

перекрытая плотность

Дэвид Б
источник
Кстати, какое программное обеспечение вы планируете использовать? Для открытого исходного кода я бы порекомендовал gnuplot.info [gnuplot]. Я верю, что в его документации вы найдете определенную технику и примеры сценариев, которые будут делать то, что вы хотите.
Ноэль Ай
1
Я использую R, как подсказывает тег (отредактированный пост, чтобы прояснить это)
David B
1
кто-то опубликовал фрагмент кода, чтобы сделать это в этой теме: stackoverflow.com/questions/3485456/…
nico

Ответы:

194

Это изображение, с которым вы связались, было для кривых плотности, а не для гистограмм.

Если вы читали на ggplot, возможно, единственное, чего вам не хватает, - это объединить два фрейма данных в один длинный.

Итак, давайте начнем с того, что у вас есть, двух отдельных наборов данных и объединим их.

carrots <- data.frame(length = rnorm(100000, 6, 2))
cukes <- data.frame(length = rnorm(50000, 7, 2.5))

# Now, combine your two dataframes into one.  
# First make a new column in each that will be 
# a variable to identify where they came from later.
carrots$veg <- 'carrot'
cukes$veg <- 'cuke'

# and combine into your new data frame vegLengths
vegLengths <- rbind(carrots, cukes)

После этого, что не нужно, если ваши данные уже в длинном формате, вам нужна только одна строка для построения графика.

ggplot(vegLengths, aes(length, fill = veg)) + geom_density(alpha = 0.2)

введите описание изображения здесь

Теперь, если вам действительно нужны гистограммы, сработает следующее. Обратите внимание, что вы должны изменить положение со стандартного аргумента «стек». Вы можете пропустить это, если не знаете, как должны выглядеть ваши данные. Более высокая альфа выглядит лучше там. Также обратите внимание, что я сделал это гистограммы плотности. Это легко удалить, y = ..density..чтобы вернуть его на счет.

ggplot(vegLengths, aes(length, fill = veg)) + 
   geom_histogram(alpha = 0.5, aes(y = ..density..), position = 'identity')

введите описание изображения здесь

Джон
источник
8
Если вы хотите остаться с гистограммами, используйте ggplot(vegLengths, aes(length, fill = veg)) + geom_bar(pos="dodge"). Это сделает чересстрочные гистограммы, как в MATLAB.
МБк
1
Спасибо за ответ! Часть 'position = "identity"' на самом деле важна, так как в противном случае столбцы сложены, что вводит в заблуждение, когда объединено с плотностью, которая по умолчанию кажется "идентичностью", то есть наложена, а не наложена.
Shadow
265

Вот еще более простое решение, использующее базовую графику и альфа-смешение (которое работает не на всех графических устройствах):

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

Ключ в том, что цвета полупрозрачны.

Правка, более двух лет спустя : так как это только что вызвало возражение, я полагаю, что я могу также добавить визуальное представление о том, что код генерирует, поскольку альфа-смешивание настолько чертовски полезно:

введите описание изображения здесь

Дирк Эддельбюттель
источник
6
+1 спасибо всем, это можно преобразовать в более гладкую гистограмму (например, had.co.nz/ggplot2/graphics/55078149a733dd1a0b42a57faf847036.png )?
Дэвид Б
3
Почему вы разделили plotкоманды? Вы можете поместить все эти опции в histкоманды и просто поместить их в две строки.
Джон
@ Джон Как бы ты это сделал?
HelloWorld
Поместите параметры plotкоманды непосредственно в команду Hist, как я уже сказал. Размещение кода - это не то, для чего нужны комментарии.
Джон
44

Вот функция, которую я написал, которая использует псевдопрозрачность для представления перекрывающихся гистограмм

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

Результаты в итоге выглядят примерно так: альтернативный текст

chrisamiller
источник
+1 за опцию, доступную на всех графических устройствах (например postscript)
Lenna
31

Уже есть красивые ответы, но я подумал добавить это. Выглядит хорошо для меня. (Скопированы случайные числа из @Dirk). 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,
источник
24

Вот пример того, как вы можете сделать это в «классической» графике 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).

nullglob
источник
Очень хорошо. Это также напомнило мне об этом одном stackoverflow.com/questions/3485456/…
Джордж Донтас
Поднятие этого, потому что этот ответ является единственным (кроме тех, что в ggplot), который непосредственно учитывает, если ваши две гистограммы имеют существенно разные размеры выборки.
MichaelChirico
Мне нравится этот метод, обратите внимание, что вы можете синхронизировать разрывы, определив их с помощью seq (). Например:breaks=seq(min(data$some_property), max(data$some_property), by=(max_prop - min_prop)/20)
Deruijter
17

Вот версия, подобная 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)

введите описание изображения здесь

Джон
источник
9

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

введите описание изображения здесь

Ларикс Децидуа
источник
Повышение этого, потому что это очень простой вариант с использованием базы и жизнеспособных на postscriptустройствах.
MichaelChirico
6

R API Plotly может быть полезным для вас. График ниже здесь .

library(plotly)
#add username and key
p <- plotly(username="Username", key="API_KEY")
#generate data
x0 = rnorm(500)
x1 = rnorm(500)+1
#arrange your graph
data0 = list(x=x0,
         name = "Carrots",
         type='histogramx',
         opacity = 0.8)

data1 = list(x=x1,
         name = "Cukes",
         type='histogramx',
         opacity = 0.8)
#specify type as 'overlay'
layout <- list(barmode='overlay',
               plot_bgcolor = 'rgba(249,249,251,.85)')  
#format response, and use 'browseURL' to open graph tab in your browser.
response = p$plotly(data0, data1, kwargs=list(layout=layout))

url = response$url
filename = response$filename

browseURL(response$url)

Полное раскрытие: я в команде.

график

Матео Санчес
источник
1

Так много хороших ответов, но так как я только что написал функцию function ( plotMultipleHistograms()), я решил добавить еще один ответ.

Преимущество этой функции заключается в том, что она автоматически устанавливает соответствующие пределы по осям X и Y и определяет общий набор бинов, который она использует во всех распределениях.

Вот как это использовать:

# Install the plotteR package
install.packages("devtools")
devtools::install_github("JosephCrispell/basicPlotteR")
library(basicPlotteR)

# Set the seed
set.seed(254534)

# Create random samples from a normal distribution
distributions <- list(rnorm(500, mean=5, sd=0.5), 
                      rnorm(500, mean=8, sd=5), 
                      rnorm(500, mean=20, sd=2))

# Plot overlapping histograms
plotMultipleHistograms(distributions, nBins=20, 
                       colours=c(rgb(1,0,0, 0.5), rgb(0,0,1, 0.5), rgb(0,1,0, 0.5)), 
                       las=1, main="Samples from normal distribution", xlab="Value")

введите описание изображения здесь

plotMultipleHistograms()Функция может принимать любое количество распределений, и все общие черчения параметры должны работать с ним (например , las, mainи т.д.).

Джозеф Криспелл
источник