web-dev-qa-db-fra.com

Comment tracer deux histogrammes ensemble dans R?

J'utilise R et j'ai deux bases de données: les carottes et les concombres. Chaque base de données comporte une seule colonne numérique qui répertorie la longueur de toutes les carottes mesurées (total: 100 000 carottes) et de concombres (total: 50 000 concombres).

Je souhaite tracer deux histogrammes - longueur de la carotte et du concombre - sur le même tracé. Ils se chevauchent, alors je suppose que j'ai aussi besoin de transparence. J'ai également besoin d'utiliser des fréquences relatives et non des nombres absolus, car le nombre d'instances dans chaque groupe est différent.

quelque chose comme ça serait bien mais je ne comprends pas comment le créer à partir de mes deux tables:

overlapped density

205
David B

Cette image à laquelle vous avez lié était destinée aux courbes de densité et non à des histogrammes.

Si vous avez lu sur ggplot, il ne vous manque peut-être que la combinaison de vos deux trames de données en une longue.

Commençons donc par quelque chose comme ce que vous avez, deux ensembles de données distincts et combinons-les.

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)

Après cela, ce qui est inutile si vos données sont déjà formelles depuis longtemps, il vous suffit d’une seule ligne pour créer votre tracé.

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

enter image description here

Maintenant, si vous voulez vraiment des histogrammes, ce qui suit fonctionnera. Notez que vous devez changer de position à partir de l'argument par défaut "stack". Cela risque de vous manquer si vous n'avez pas vraiment une idée de ce à quoi vos données devraient ressembler. Un alpha plus élevé y paraît mieux. Notez également que j'ai créé des histogrammes de densité. Il est facile de retirer le y = ..density.. pour le ramener au compte.

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

enter image description here

181
John

Voici une solution encore plus simple utilisant des graphiques de base et une fusion alpha (qui ne fonctionne pas sur tous les périphériques graphiques):

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

La clé est que les couleurs sont semi-transparentes.

Edit, plus de deux ans plus tard: Comme cela vient de recevoir un vote positif, je pense que je pourrais aussi bien ajouter un visuel de ce que le code produit en tant que mélange alpha est extrêmement utile:

enter image description here

242
Dirk Eddelbuettel

Voici une fonction que j'ai écrite que tilise une pseudo-transparence pour représenter des histogrammes superposés

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

Voici ne autre façon de le faire en utilisant le support de R pour les couleurs transparentes

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

Les résultats finissent par ressembler à ceci: alt text

41
chrisamiller

Déjà de belles réponses sont là, mais j'ai pensé à ajouter ceci. Cela me semble correct. (Nombres aléatoires copiés de @Dirk). library(scales) est nécessaire`

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)

Le résultat est...

enter image description here

Mise à jour: Cette fonction chevauchement peut également être utile à certains.

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

Je sens que le résultat de hist0 est plus joli à regarder que 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) }

Le résultat de

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

est

enter image description here

29
Stat-R

Voici un exemple de la façon dont vous pouvez le faire dans les graphiques R "classiques":

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

Le seul problème avec cela est que cela semble beaucoup mieux si les coupures de l'histogramme sont alignées, ce qui peut être fait manuellement (dans les arguments passés à hist).

24
nullglob

Voici la version semblable à celle de ggplot2 que je n’ai donnée qu’en base R. J'en ai copié certaines depuis @nullglob.

générer les données

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

Vous n'avez pas besoin de le placer dans un cadre de données comme avec ggplot2. L'inconvénient de cette méthode est que vous devez écrire beaucoup plus de détails de l'intrigue. L'avantage est que vous avez le contrôle sur plus de détails de l'intrigue.

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

16
John

@Dirk Eddelbuettel: L'idée de base est excellente mais le code affiché peut être amélioré. [Cela prend longtemps à expliquer, d'où une réponse séparée et non un commentaire.]

La fonction hist() dessine des tracés par défaut. Vous devez donc ajouter l'option plot=FALSE. De plus, il est plus facile d'établir la zone de tracé par un appel plot(0,0,type="n",...) dans lequel vous pouvez ajouter les étiquettes d'axe, le titre de tracé, etc. Enfin, je voudrais mentionner que l'on pourrait également utiliser un ombrage pour distinguer les deux histogrammes. . Voici le code:

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)

Et voici le résultat (un peu trop large à cause de RStudio :-)):

enter image description here

9
Laryx Decidua

L'API R de Plotly pourrait vous être utile. Le graphique ci-dessous est ici .

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)

Divulgation complète: je suis dans l'équipe.

Graph

6
Mateo Sanchez

Autant de bonnes réponses mais comme je viens d'écrire une fonction (plotMultipleHistograms()) pour le faire, j'ai pensé ajouter une autre réponse.

L’avantage de cette fonction est qu’elle définit automatiquement les limites appropriées des axes X et Y et définit un ensemble commun de cases qu’elle utilise dans toutes les distributions.

Voici comment l'utiliser:

# 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

La fonction plotMultipleHistograms() peut prendre un nombre quelconque de distributions, et tous les paramètres de traçage généraux devraient fonctionner avec elle (par exemple: las, main, etc.).

0
Joseph Crispell