Add an additional X axis to the plot and some lines/annotations to show the percentage of data under it

user_13323413 0
Viewed 67

I was trying to recreate this plot:

1 using the following code -

library(tidyverse)
set.seed(0); r <- rnorm(10000);
df <- as.data.frame(r)

avg <- round(mean(r),2)
SD <- round(sd(r),2)
x.scale <- seq(from = avg - 3*SD, to = avg + 3*SD, by = SD)
x.lab <- c("-3SD", "-2SD", "-1SD", "Mean", "1SD", "2SD", "3SD")

df %>% ggplot(aes(r)) +
  geom_histogram(aes(y=..density..), bins = 20,
                 colour="black", fill="lightblue") +
  geom_density(alpha=.2, fill="darkblue") +
  scale_x_continuous(breaks = x.scale, labels = x.lab) +
  labs(x = "")

Using the code I plotted this:

2,

but this isn't near to the plot that I am trying to create. How do I make an additional axis with the X axis? How do I add the lines to automatically show the percentage of observations? Is there any way, that I can create the plot as nearly identical as possible using ggplot2?

ggplot2 r visualization
1 Answers

Welcome to SO. Excellent first question!

It's actually quite tricky. You'd need to create a second plot (the second x axis) but it's not the most straight forward to align both perfectly.

I will be using Z.lin's amazing modification of the cowplot package.

I am not using the reprex package, because I think I'd need to define every single function (and I don't know how to use trace within reprex.)

library(tidyverse)
library(cowplot)

set.seed(0); r <- rnorm(10000);
foodf <- as.data.frame(r)
avg <- round(mean(r),2)
SD <- round(sd(r),2)
x.scale <- round(seq(from = avg - 3*SD, to = avg + 3*SD, by = SD), 1)
x.lab <- c("-3SD", "-2SD", "-1SD", "Mean", "1SD", "2SD", "3SD")
x2lab <- -3:3

# calculate the density manually 
dens_r <- density(r)

# for each x value, calculate the closest x value in the density object and get the respective y values
y_dens <- dens_r$y[sapply(x.scale, function(x) which.min(abs(dens_r$x - x)))]

# added annotation for segments and labels. 
# Arrow segments can be added in a similar way. 
p1 <- 
  ggplot(foodf, aes(r)) +
  geom_histogram(aes(y=..density..), bins = 20,
                 colour="black", fill="lightblue") +
  geom_density(alpha=.2, fill="darkblue") +
  scale_x_continuous(breaks = x.scale, labels = x.lab) +
  labs(x = NULL) +# use NULL here 
  annotate(geom = "segment", x = x.scale, xend = x.scale, 
           yend = 1.1 * max(dens_r$y), y = y_dens, lty = 2 ) +
  annotate(geom = "text", label = x.lab, 
           x = x.scale, y = 1.2 * max(dens_r$y))
p2 <- 
  ggplot(foodf, aes(r)) +
  scale_x_continuous(breaks = x.scale, labels = x2lab) +
    labs(x = NULL) +
    theme_classic() +
    theme(axis.line.y = element_blank())

# This is with the modified plot_grid() / align_plot() function!!! 

plot_grid(p1, p2, ncol = 1, align = "v", rel_heights = c(1, 0.1))

enter image description here

user_79411880
Related