Как построить две гистограммы вместе в R?
Я использую R, и у меня есть два кадра данных: морковь и огурцы. Каждый фрейм данных имеет один числовой столбец, в котором указана длина всех измеренных морковей (всего: 100 тысяч моркови) и огурцов (всего: 50 тысяч огурцов).
Я хочу построить две гистограммы - длина моркови и длина огурцов - на одном участке. Они пересекаются, так что, мне кажется, мне нужна прозрачность. Мне также нужно использовать относительные частоты, а не абсолютные числа, так как количество экземпляров в каждой группе различно.
что-то вроде этого было бы неплохо, но я не понимаю, как создать его из моих двух таблиц:
8 ответов
Это изображение, с которым вы связались, было для кривых плотности, а не для гистограмм.
Если вы читали на 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)
Полное раскрытие: я в команде.
Так много хороших ответов, но так как я только что написал функцию (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, так далее.).