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

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

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

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

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

Если вы читали на 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')

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

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

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

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

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

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

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

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

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

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

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

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)

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

Так много хороших ответов, но так как я только что написал функцию 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и т.д.).