Combine/Overlay boxplot with histogram in R - r

I need to combine the boxplot with the histogram using ggplot2. So far I have this code.
library(dplyr)
library(ggplot2)
data(mtcars)
dat <- mtcars %>% dplyr::select(carb, wt) %>%
dplyr::group_by(carb) %>% dplyr::mutate(mean_wt = mean(wt), carb_count = n())
plot<-ggplot(data=mtcars, aes(x=carb, y=..count..)) +
geom_histogram(alpha=0.3, position="identity", lwd=0.2,binwidth=1)+
theme_bw()+
theme(panel.border = element_rect(colour = "black", fill=NA, size=0.7))+
geom_text(data=aggregate(mean_wt~carb+carb_count,dat,mean), aes(carb, carb_count+0.5, label=round(mean_wt,1)), color="black")
plot + geom_boxplot(data = mtcars,mapping = aes(x = carb, y = 6*wt,group=carb),
color="black", fill="red", alpha=0.2,width=0.1,outlier.shape = NA)+
scale_y_continuous(name = "Count",
sec.axis = sec_axis(~./6, name = "Weight"))
This results in
However, I dont want the secondary y axis to be the same length of primary y axis. I want the secondary y axis to be smaller and on the top right corner only. Lets say secondary y axis should scale between 20-30 of primary y axis and the box plot should also scale with the axis.
Can anyone help me with this?

Here's one approach, where I adjusted the secondary axis formula and tweaked the way it's labeled. (EDIT: adjusted to make boxplots bigger, per OP comment.)
plot + geom_boxplot(data = mtcars,
# Adj'd scaling so each 1 wt = 2.5 count
aes(x = carb, y = (wt*2.5)+10,group=carb),
color="black", fill="red", alpha=0.2,
width=0.5, outlier.shape = NA)+ # Wider width
scale_y_continuous(name = "Count", # Adj'd labels to limit left to 0, 5, 10
breaks = 5*0:5, labels = c(5*0:2, rep("", 3)),
# Adj'd scaling to match the wt scaling
sec.axis = sec_axis(~(.-10)/2.5, name = "Weight",
breaks = c(0:5))) +
theme(axis.title.y.left = element_text(hjust = 0.15, vjust = 1),
axis.title.y.right = element_text(hjust = 0.15, vjust = 1))
You might also consider an alternative using the patchwork package, coincidentally written by the same developer who implemented secondary scales in ggplot2...
# Alternative solution using patchwork
library(patchwork)
plot2 <- ggplot(data=mtcars, aes(x=carb, y=..count..)) +
theme_bw()+
theme(panel.border = element_rect(colour = "black", fill=NA, size=0.7))+
geom_boxplot(data = mtcars,
aes(x = carb, y = wt, group=carb),
color="black", fill="red", alpha=0.2,width=0.1,outlier.shape = NA) +
scale_y_continuous(name = "Weight") +
scale_x_continuous(labels = NULL, name = NULL,
expand = c(0, 0.85), breaks = c(2,4,6,8))
plot2 + plot + plot_layout(nrow = 2, heights = c(1,3)) +
labs(x=NULL)

Related

Log10 Y-Axis starting from 0

I created a bar plot to show differences in water accumulation on different sites and layers. Because one value is way higher than the other ones I want to set the y-axis on log10 scale. It all works but the result looks rather unintuitive. is it possible to set the limit of the y-axis to 0 so the bar with the value 0.2 is not going downwards?
Here is the code I used:
p2 <- ggplot(data_summary2, aes(x= Site, y= small_mean, fill= Depth, Color= Depth))+
geom_bar(stat = "identity", position = "dodge", alpha=1)+
geom_errorbar(aes(ymin= small_mean - sd, ymax= small_mean + sd),
position = position_dodge(0.9),width=0.25, alpha= 0.6)+
scale_fill_brewer(palette = "Greens")+
geom_text(aes(label=small_mean),position=position_dodge(width=0.9), vjust=-0.25, hjust= -0.1, size= 3)+
#geom_text(aes(label= Tukey), position= position_dodge(0.9), size=3, vjust=-0.8, hjust= -0.5, color= "gray25")+
theme_bw()+
theme(legend.position = c(0.2, 0.9),legend.direction = "horizontal")+
theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())+
labs(fill="Depth [cm]")+
theme(axis.text.x = element_text(angle = 25, size =9, vjust = 1, hjust=1))+
scale_x_discrete(labels= c( "Site 1\n(Hibiscus tillaceus)","Site 2 \n(Ceiba pentandra)","Site 3 \n(Clitoria fairchildiana)","Site 4 \n(Pachira aquatica)"))+
#theme(legend.position = c(0.85, 0.7))+
labs(x= "Sites\n(Type of Tree)", y= "µg Deep-Water/ g rhizosphere soil", title = "Average microbial Deep-water incorporation per Site", subtitle = "Changes over Time and Depth")+
facet_grid(.~Time, scale = "free")
p2 + scale_y_continuous(trans = "log10")
This is what the plot looks like:
On a log scale there is no 0, therefore the only sensible place for bars to start from is y = 10^0 or 1.
However you can create a pseudolog scale using scales::pseudo_log_trans to get 0 included on the axis so all the bars go the same direciton. I'm borrowing from this answer. NOTE it's important to add 0 to the breaks to make it clear that this is a pseudolog scale. Compare the two plots below:
library(tidyverse)
library(scales)
# make up data with distribution positive values above and below 1
d <- tibble(grp = LETTERS[1:5],
val = 10^(-2:2))
# normal plot with true log scale doesn't contain 0
d %>%
ggplot(aes(x = grp, y = val, fill = grp)) +
geom_col() +
ggtitle("On True Log Scale Bars Start at y = 1") +
scale_y_log10() # or if you prefer: scale_y_continuous(trans = "log10")
# set range of 'linear' portion of pseudolog scale
sigma <- min(d$val)
# plot on pseudolog to get all bars to extend to 0
d %>%
ggplot(aes(x = grp, y = val, fill = grp)) +
geom_col() +
ggtitle("On Pseudolog Scale Bars Start at y = 0") +
scale_y_continuous(
trans = pseudo_log_trans(base = 10, sigma = sigma),
breaks = c(0, 10^(-2:2)),
labels = label_number(accuracy = 0.01)
)
Created on 2021-12-30 by the reprex package (v2.0.1)

ggplot: Add annotations using separate data above faceted chart

I'm trying to add set of markers with text above the top of a faceted chart to indicate certain points of interest in the value of x. Its important that they appear in the right position left to right (as per the main scale), including when the overall ggplot changes size.
Something like this...
However, I'm struggling to:
place it in the right vertical position (above the facets). In my
reprex below (a simplified version of the original), I tried using a
value of the factor (Merc450 SLC), but this causes issues such as adding that to
every facet including when it is not part of that facet and doesn't
actually go high enough. I also tried converting the factor to a number using as.integer, but this causes every facet to include all factor values, when they obviously shouldn't
apply to the chart as a whole, not each
facet
Note that in the full solution, the marker x values are independent of the main data.
I have tried using cowplot to draw it separately and overlay it, but that seems to:
affect the overall scale of the main plot, with the facet titles on the right being cropped
is not reliable in placing the markers at the exact location along the x scale
Any pointers welcome.
library(tidyverse)
mtcars2 <- rownames_to_column(mtcars, var = "car") %>%
mutate(make = stringr::word(car, 1)) %>%
filter(make >= "m" & make < "n")
markers <- data.frame(x = c(max(mtcars2$mpg), rep(runif(nrow(mtcars2), 1, max(mtcars2$mpg))), max(mtcars2$mpg))) %>%
mutate(name = paste0("marker # ", round(x)))
ggplot(mtcars2, aes()) +
# Main Plot
geom_tile(aes(x = mpg, y = car, fill = cyl), color = "white") +
# Add Markers
geom_point(data = markers, aes(x = x, y = "Merc450 SLC"), color = "red") +
# Marker Labels
geom_text(data = markers, aes(x = x, "Merc450 SLC",label = name), angle = 45, size = 2.5, hjust=0, nudge_x = -0.02, nudge_y = 0.15) +
facet_grid(make ~ ., scales = "free", space = "free") +
theme_minimal() +
theme(
# Facets
strip.background = element_rect(fill="Gray90", color = "white"),
panel.background = element_rect(fill="Gray95", color = "white"),
panel.spacing.y = unit(.7, "lines"),
plot.margin = margin(50, 20, 20, 20)
)
Perhaps draw two separate plots and assemble them together with patchwork:
library(patchwork)
p1 <- ggplot(markers, aes(x = x, y = 0)) +
geom_point(color = 'red') +
geom_text(aes(label = name),
angle = 45, size = 2.5, hjust=0, nudge_x = -0.02, nudge_y = 0.02) +
scale_y_continuous(limits = c(-0.01, 0.15), expand = c(0, 0)) +
theme_minimal() +
theme(axis.text = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank())
p2 <- ggplot(mtcars2, aes(x = mpg, y = car, fill = cyl)) +
geom_tile(color = "white") +
facet_grid(make ~ ., scales = "free", space = "free") +
theme_minimal() +
theme(
strip.background = element_rect(fill="Gray90", color = "white"),
panel.background = element_rect(fill="Gray95", color = "white"),
panel.spacing.y = unit(.7, "lines")
)
p1/p2 + plot_layout(heights = c(1, 9))
It required some workaround with plot on different plot and using cowplot alignment function to align them on the same axis. Here is a solution
library(tidyverse)
library(cowplot)
# define a common x_axis to ensure that the plot are on same scales
# This may not needed as cowplot algin_plots also adjust the scale however
# I tended to do this extra step to ensure.
x_axis_common <- c(min(mtcars2$mpg, markers$x) * .8,
max(mtcars2$mpg, markers$x) * 1.1)
# Plot contain only marker
plot_marker <- ggplot() +
geom_point(data = markers, aes(x = x, y = 0), color = "red") +
# Marker Labels
geom_text(data = markers, aes(x = x, y = 0,label = name),
angle = 45, size = 2.5, hjust=0, nudge_x = 0, nudge_y = 0.001) +
# using coord_cartesian to set the zone of plot for some scales
coord_cartesian(xlim = x_axis_common,
ylim = c(-0.005, 0.03), expand = FALSE) +
# using theme_nothing from cow_plot which remove all element
# except the drawing
theme_nothing()
# main plot with facet
main_plot <- ggplot(mtcars2, aes()) +
# Main Plot
geom_tile(aes(x = mpg, y = car, fill = cyl), color = "white") +
coord_cartesian(xlim = x_axis_common, expand = FALSE) +
# Add Markers
facet_grid(make ~ ., scales = "free_y", space = "free") +
theme_minimal() +
theme(
# Facets
strip.background = element_rect(fill="Gray90", color = "white"),
panel.background = element_rect(fill="Gray95", color = "white"),
panel.spacing.y = unit(.7, "lines"),
plot.margin = margin(0, 20, 20, 20)
)
Then align the plot and plot them using cow_plot
# align the plots together
temp <- align_plots(plot_marker, main_plot, axis = "rl",
align = "hv")
# plot them with plot_grid also from cowplot - using rel_heights for some
# adjustment
plot_grid(temp[[1]], temp[[2]], ncol = 1, rel_heights = c(1, 8))
Created on 2021-05-03 by the reprex package (v2.0.0)

Raincloud plot - histogram?

I would like to create a raincloud plot. I have successfully done it. But I would like to know if instead of the density curve, I can put a histogram (it's better for my dataset).
This is my code if it can be usefull
ATSC <- ggplot(data = data, aes(y = atsc, x = numlecteur, fill = numlecteur)) +
geom_flat_violin(position = position_nudge(x = .2, y = 0), alpha = .5) +
geom_point(aes(y = atsc, color = numlecteur), position = position_jitter(width = .15), size = .5, alpha = 0.8) +
geom_point(data = sumld, aes(x = numlecteur, y = mean), position = position_nudge(x = 0.25), size = 2.5) +
geom_errorbar(data = sumld, aes(ymin = lower, ymax = upper, y = mean), position = position_nudge(x = 0.25), width = 0) +
guides(fill = FALSE) +
guides(color = FALSE) +
scale_color_brewer(palette = "Spectral") +
scale_y_continuous(breaks=c(0,2,4,6,8,10), labels=c("0","2","4","6","8","10"))+
scale_fill_brewer(palette = "Spectral") +
coord_flip() +
theme_bw() +
expand_limits(y=c(0, 10))+
xlab("Lecteur") + ylab("Age total sans check")+
raincloud_theme
I think we can maybe put the "geom_histogram()" but it doesn't work
Thank you in advance for your help !
(sources : https://peerj.com/preprints/27137v1.pdf
https://neuroconscience.wordpress.com/2018/03/15/introducing-raincloud-plots/)
This is actually not quite easy. There are a few challenges.
geom_histogram is "horizontal by nature", and the custom geom_flat_violin is vertical - as are boxplots. Therefore the final call to coord_flip in that tutorial. In order to combine both, I think best is switch x and y, forget about coord_flip, and use ggstance::geom_boxploth instead.
Creating separate histograms for each category is another challenge. My workaround to create facets and "merge them together".
The histograms are scaled way bigger than the width of the points/boxplots. My workaround scale via after_stat function.
How to nudge the histograms to the right position above Boxplot and points - I am converting the discrete scale to a continuous by mapping a constant numeric to the global y aesthetic, and then using the facet labels for discrete labels.
library(tidyverse)
my_data<-read.csv("https://data.bris.ac.uk/datasets/112g2vkxomjoo1l26vjmvnlexj/2016.08.14_AnxietyPaper_Data%20Sheet.csv")
my_datal <-
my_data %>%
pivot_longer(cols = c("AngerUH", "DisgustUH", "FearUH", "HappyUH"), names_to = "EmotionCondition", values_to = "Sensitivity")
# use y = -... to position boxplot and jitterplot below the histogram
ggplot(data = my_datal, aes(x = Sensitivity, y = -.5, fill = EmotionCondition)) +
# after_stat for scaling
geom_histogram(aes(y = after_stat(count/100)), binwidth = .05, alpha = .8) +
# from ggstance
ggstance::geom_boxploth( width = .1, outlier.shape = NA, alpha = 0.5) +
geom_point(aes(color = EmotionCondition), position = position_jitter(width = .15), size = .5, alpha = 0.8) +
# merged those calls to one
guides(fill = FALSE, color = FALSE) +
# scale_y_continuous(breaks = 1, labels = unique(my_datal$EmotionCondition))
scale_color_brewer(palette = "Spectral") +
scale_fill_brewer(palette = "Spectral") +
# facetting, because each histogram needs its own y
# strip position = left to fake discrete labels in continuous scale
facet_wrap(~EmotionCondition, nrow = 4, scales = "free_y" , strip.position = "left") +
# remove all continuous labels from the y axis
theme(axis.title.y = element_blank(), axis.text.y = element_blank(),
axis.ticks.y = element_blank())
Created on 2021-04-15 by the reprex package (v1.0.0)

How to add a legend manually for line chart

i need the plan legend
How to add a legend manually for geom_line
ggplot(data = impact_end_Current_yr_m_actual, aes(x = month, y = gender_value)) +
geom_col(aes(fill = gender))+theme_classic()+
geom_line(data = impact_end_Current_yr_m_plan, aes(x=month, y= gender_value, group=1),color="#288D55",size=1.2)+
geom_point(data = impact_end_Current_yr_m_plan, aes(x=month, y=gender_value))+
theme(axis.line.y = element_blank(),axis.ticks = element_blank(),legend.position = "bottom", axis.text.x = element_text(face = "bold", color = "black", size = 10, angle = 0, hjust = 1))+
labs(x="", y="End Beneficiaries (in Num)", fill="")+
scale_fill_manual(values=c("#284a8d", "#00B5CE","#0590eb","#2746c2"))+
scale_y_continuous(labels = function(x) format(x, scientific = FALSE)
The neatest way to do it I think is to add colour = "[label]" into the aes() section of geom_line() then put the manual assigning of a colour into scale_colour_manual() here's an example from mtcars (apologies that it uses stat_summary instead of geom_line but does the same trick):
library(tidyverse)
mtcars %>%
ggplot(aes(gear, mpg, fill = factor(cyl))) +
stat_summary(geom = "bar", fun = mean, position = "dodge") +
stat_summary(geom = "line",
fun = mean,
size = 3,
aes(colour = "Overall mean", group = 1)) +
scale_fill_discrete("") +
scale_colour_manual("", values = "black")
Created on 2020-12-08 by the reprex package (v0.3.0)
The limitation here is that the colour and fill legends are necessarily separate. Removing labels (blank titles in both scale_ calls) doesn't them split them up by legend title.
In your code you would probably want then:
...
ggplot(data = impact_end_Current_yr_m_actual, aes(x = month, y = gender_value)) +
geom_col(aes(fill = gender))+
geom_line(data = impact_end_Current_yr_m_plan,
aes(x=month, y= gender_value, group=1, color="Plan"),
size=1.2)+
scale_color_manual(values = "#288D55") +
...
(but I cant test on your data so not sure if it works)

Include 2nd variable labels on an existing Variable vs sample plot geom_jitter

I have a geom_jitter plot showing Variables between 2 samples, I would like to include the Group-variable parameters on the left of the plot, setting a separation by lines like in the figure below. Thus, Variables are organised by Group.
Here is a reproducible example:
data<- tibble::tibble(
Variable = c("A","B","C","D","E", "F"),
Group = c("Asia","Asia","Europe","Europe","Africa","America"),
sample1 = c(0.38,0.22,0.18,0.12,0.1,0),
sample2 = c(0.23,0.2,0,0.12,0.11,0.15))
library(reshape2)
data2<- melt(data,
id.vars=c("Variable", "Group"),
measure.vars=c("sample1", "sample2"),
variable.name="Sample",
value.name="value")
data22[is.na(data22)] <- 0
library(ggplot2)
ggplot(data2, aes(x = Sample, y = Variable, label=NA)) +
geom_point(aes(size = value, colour = value)) +
geom_text(hjust = 1, size = 2) +
# scale_size(range = c(1,3)) +
theme_bw()+
scale_color_gradient(low = "lightblue", high = "darkblue")
Here is the current output I have:
And this is the format I would like:
To get a polished version of the plot most similar to your ideal plot, you can use facet_grid() plus some theme() customization.
ggplot(data2, aes(x = Sample, y = Variable, label=NA)) +
geom_point(aes(size = value, colour = value)) +
geom_text(hjust = 1, size = 2) +
# scale_size(range = c(1,3)) +
theme_bw()+
scale_color_gradient(low = "lightblue", high = "darkblue") +
facet_grid(Group~., scales = "free", switch = "y") +
theme(strip.placement = "outside",
strip.text.y = element_text(angle = 180),
panel.spacing = unit(0, "cm"))

Resources