Как построить две гистограммы вместе в R? - PullRequest
200 голосов
/ 22 августа 2010

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

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

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

overlapped density

Ответы [ 9 ]

240 голосов
/ 24 августа 2010

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

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

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

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

enter image description here

175 голосов
/ 22 августа 2010

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

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

enter image description here

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

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

enter image description here

41 голосов
/ 22 августа 2010

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

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

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

28 голосов
/ 06 ноября 2014

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

Результат ...

enter image description here

Обновление: Это перекрытие функция также может быть полезна для некоторых.

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)

is

enter image description here

24 голосов
/ 22 августа 2010

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

16 голосов
/ 22 августа 2010

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

enter image description here

9 голосов
/ 09 октября 2014

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

enter image description here

6 голосов
/ 23 января 2014

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

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)

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

Graph

0 голосов
/ 23 апреля 2019

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

enter image description here

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

...