ggplot2 remove legend.key box after combining multiple geom layers - r

I am quite new to ggplot2 and it's been challenging to reproduce a similar chart in Excel. I almost got it to work, but now I need to figure out a way to make the geom_point/line's legend key (3rd item in the legend) to not show the box around it.
Note: I know there are answers to similar problem by using + theme(legend.key = element_blank()), but it has no effect on the legend. I suspect it has something to do with the scale_*_manual in the code. Any other solutions would be truly appreciated!
test <- data.frame(
group = 1:5,
cnt = rep(600, 5),
pct_cnt = rep(0.2, 5),
prem = c(12000000, 9800000, 8700000, 11000000, 3500000),
pct_prem = c(0.266666667, 0.217777778, 0.193333333, 0.244444444,
0.077777778),
relativity = c(1.5, 1.2, 1, 0.8, 0.4)
)
theme_set(theme_minimal())
normalizer <- round(max(test$relativity) / max(test$pct_prem), 0)
ggplot(test, aes(x = group)) +
geom_bar(aes(y = pct_prem, fill = 'prem', color = 'prem'), stat = 'identity', position = position_nudge(x = -0.1), width = 0.2) +
geom_bar(aes(y = pct_cnt, fill = 'cnt', color = 'cnt'), stat = 'identity', position = position_nudge(x = 0.1), width = 0.2) +
geom_point(aes(y = relativity / normalizer, color = 'rel', fill = 'rel'), size = 5) +
geom_line(aes(y = relativity / normalizer, color = 'rel'), size = 2) +
scale_color_manual(name = 'metric', values = c('prem' = NA, 'cnt' = NA, 'rel' = 'skyblue'),
labels = c('prem' = '%Prem', 'cnt' = '%Count', 'rel' = 'LRR')) +
scale_fill_manual(name = 'metric', values = c('prem' = 'orange', 'cnt' = 'dark green', 'rel' = NA),
labels = c('prem' = '%Prem', 'cnt' = '%Count', 'rel' = 'LRR')) +
scale_y_continuous(limits = c(0, 0.4), sec.axis = sec_axis(~.*normalizer, breaks = seq(0, 0.4, 0.1) * normalizer, name = 'relativity'))

I'm not sure if there is a method using just ggplot, since the color of the box and the color of your legend key itself change simultaneously when using the common override.aes fix. Going into the gtable, you could do it this way (after assigning your plot to p):
library(grid)
grb <- ggplotGrob(p)
#get the index of the legend-grob and store grob as leg
leg_index <- grep("guide-box", sapply(grb$grobs, function(x) x$name))
leg <- grb$grobs[[leg_index]]
Then, you want to look in the legend's gtable. The key bg to be changed is the last one, so check at the bottom for rect backgrounds. I.e., here
13 13 (6-6,2-2) key-5-1-bg zeroGrob[legend.key..zeroGrob.3081]
14 14 (6-6,2-2) key-5-1-1 rect[GRID.rect.3082]
15 15 (6-6,2-2) key-5-1-2 rect[GRID.rect.3083]
16 16 (6-6,2-2) key-5-1-3 points[GRID.points.3084]
17 17 (6-6,2-2) key-5-1-4 segments[GRID.segments.3085]
Indices 14 and 15 are the ones belonging to the last key. To make sure the bg is removed, just change the graphic parameters of both of them. Then replace the old legend with your changed one.
leg$grobs[[1]]$grobs[[14]]$gp$col <- "white"
leg$grobs[[1]]$grobs[[15]]$gp$col <- "white"
grb$grobs[[leg_index]] <- leg
grid.newpage()
grid.draw(grb)

To move a legend on the bottom of the graph you add "bottom" to legend.position like this....
theme(legend.position="bottom")
here is your original code adjusted..
ggplot(test, aes(x = group)) +
geom_bar(aes(y = pct_prem, fill = 'prem', color = 'prem'), stat = 'identity', position = position_nudge(x = -0.1), width = 0.2, alpha = 1) +
geom_bar(aes(y = pct_cnt, fill = 'cnt', color = 'cnt'), stat = 'identity', position = position_nudge(x = 0.1), width = 0.2) +
geom_point(aes(y = relativity / normalizer, color = 'rel', fill = 'rel'), size = 5) +
geom_line(aes(y = relativity / normalizer, color = 'rel'), size = 2) +
scale_color_manual(name = 'metric', values = c('prem' = NA, 'cnt' = NA, 'rel' = 'skyblue'),
labels = c('prem' = '%Prem', 'cnt' = '%Count', 'rel' = 'LRR')) +
scale_fill_manual(name = 'metric', values = c('prem' = 'orange', 'cnt' = 'dark green', 'rel' = NA),
labels = c('prem' = '%Prem', 'cnt' = '%Count', 'rel' = 'LRR')) +
scale_y_continuous(limits = c(0, 0.4) , sec.axis = sec_axis(~.*normalizer, breaks = seq(0, 0.4, 0.1) * normalizer, name = 'relativity'))+
theme(legend.position="bottom")
For further adjustments that can be made look up theme (tons of options)
?theme
Hope this helps!

Related

How to present the results of a dataframe in a serial scale using ggplot as in the example attached?

I have this data frame :
Raw.Score = c(0,1,2,3,4,5,6,7,8)
Severity = c(-3.56553994,-2.70296933,-1.63969850,-0.81321707,-0.04629182,
0.73721320,1.61278518,2.76647043,3.94804472)
x = data.frame(Raw.Score = Raw.Score, Severity = Severity)
Raw.score are raw numbers from 0 to 8 (let's consider them as the labels of the severity numbers)
Severity are relative numbres that represent the locations of the scores in the diagram
I want to graphically present the results as in the following example using ggplot (the example includes different numbers but I want something similar)
As a fun exercise in ggplot-ing here is one approach to achieve or come close to your desired result.
Raw.Score = c(0,1,2,3,4,5,6,7,8)
Severity = c(-3.56553994,-2.70296933,-1.63969850,-0.81321707,-0.04629182,
0.73721320,1.61278518,2.76647043,3.94804472)
dat <- data.frame(Raw.Score, Severity)
library(ggplot2)
dat_tile <- data.frame(
Severity = seq(-4.1, 4.1, .05)
)
dat_axis <- data.frame(
Severity = seq(-4, 4, 2)
)
tile_height = .15
ymax <- .5
ggplot(dat, aes(y = 0, x = Severity, fill = Severity)) +
# Axis line
geom_hline(yintercept = -tile_height / 2) +
# Colorbar
geom_tile(data = dat_tile, aes(color = Severity), height = tile_height) +
# Sgements connecting top and bottom labels
geom_segment(aes(xend = Severity, yend = -ymax, y = ymax), color = "orange") +
# Axis ticks aka dots
geom_point(data = dat_axis,
y = -tile_height / 2, shape = 21, stroke = 1, fill = "white") +
# ... and labels
geom_text(data = dat_axis, aes(label = Severity),
y = -tile_height / 2 - .1, vjust = 1, fontface = "bold") +
# Bottom labels
geom_label(aes(y = -ymax, label = scales::number(Severity, accuracy = .01))) +
# Top labels
geom_point(aes(y = ymax, color = Severity), size = 8) +
geom_text(aes(y = ymax, label = Raw.Score), fontface = "bold") +
# Colorbar annotations
annotate(geom = "text", fontface = "bold", label = "MILD", color = "black", x = -3.75, y = 0) +
annotate(geom = "text", fontface = "bold", label = "SEVERE", color = "white", x = 3.75, y = 0) +
# Fixing the scales
scale_x_continuous(expand = c(0, 0)) +
scale_y_continuous(limits = c(-ymax, ymax)) +
# Color gradient
scale_fill_gradient(low = "orange", high = "red", guide = "none") +
scale_color_gradient(low = "orange", high = "red", guide = "none") +
# Get rid of all non-data ink
theme_void() +
# Add some plot margin
theme(plot.margin = rep(unit(10, "pt"), 4)) +
coord_cartesian(clip = "off")

R ggplot2 ggrepel labelling positions

I am trying to add labels to a ggplot object. The labels do not look neat and tidy due to their positioning. I have tried using various geom_label_repel and geom_text_repel options but am not having much luck.
I cannot share the data unfortunately, but I have inserted one of my codes below and a screenshot of one section of the redacted graph. The graph has multiple peaks that need labelling. Each label has 2 lines.
I would like the lines connecting the labels to be directly above each peak on the x axis, then turn at a right angle and the line continue horizontally slightly. I would then like the label to sit on top of this horizontal section of the line.
Some peaks are very close together, so the labels will end up being pushed up the y axis so they are able to stack up neatly.
I hope that description makes sense. I would appreciate it if anyone is able to help.
Thank you!
library(ggplot2)
library(ggrepel)
library(dplyr)
upper_plot <- ggplot() +
geom_point(data = plot_data[which(analysis == "Analysis1"),],
aes(x = rel_pos, y = logged_p, color = as.factor(chr)),
size = 0.25) +
scale_color_manual(values = rep(my_upper_colors, nrow(axis_df))) +
geom_point(data=upper_highlight_pos2_old,
aes(x = rel_pos, y = logged_p),
color= c('grey'),
size=0.75,
pch = 16) +
geom_point(data=upper_labels_old,
aes(x = rel_pos, y = logged_p),
color='dark grey',
size=2,
pch = 18) +
geom_point(data=upper_highlight_pos2_novel,
aes(x = rel_pos, y = logged_p),
color= c('black'),
size=0.75,
pch = 16) +
geom_point(data=upper_labels_novel,
aes(x = rel_pos, y = logged_p),
color='black',
size=2,
pch = 18) +
scale_x_continuous(labels = axis_df$chr,
breaks = axis_df$chr_center,
expand = expansion(mult = 0.01)) +
scale_y_continuous(limits = c(0, maxp),
expand = expansion(mult = c(0.02, 0.06))) +
# geom_hline(yintercept = -log10(1e-5), color = "red", linetype = "dashed",
# size = 0.3) +
geom_hline(yintercept = -log10(5e-8), color = "black", linetype = "dashed",
size = 0.3) +
labs(x = "", y = bquote(atop('GWAS', '-log'[10]*'(p)'))) +
theme_classic() +
theme(legend.position = "none",
axis.title.x = element_blank(),
plot.margin = margin(t=5, b = 5, r=5, l = 10)) +
geom_label_repel(data = upper_labels,
aes(x = rel_pos, y = logged_p, label = label),
ylim = c(maxp / 3, NA),
size = 2,
force_pull = 0,
nudge_x = 0.5,
box.padding = 0.5,
nudge_y = 0.5,
min.segment.length = 0, # draw all lines no matter how short
segment.size = 0.2,
segment.curvature = -0.1,
segment.ncp = 3,
segment.angle = 45,
label.size=NA, #no border/box
fill = NA, #no background
)
This is my current untidy layout...
EDIT:
This is the sort of layout I am after. The lines will need to be flexible and either be right-handed or left-handed depending on space (source: https://www.nature.com/articles/s41588-020-00725-7)

R add legend for multiple layers

I want to add a legend for the plot, but it doesn't work,
can anyone please help me to see where it went wrong.
this is the code.
ggplot(data = dfNorm1, aes(x = X)) +
geom_col(aes(y = Government_suppliment),
fill = "#0000FF", color = "white", alpha = 0.8) +
geom_smooth(data = subset(dfNorm1,X >= 24), aes(y = Government_suppliment),
method = "lm", se = FALSE, color = "#FF4040",
linetype = "dashed", size = 0.7) +
geom_smooth(data = subset(dfNorm1, X <= 24), aes(y = Government_suppliment),
method = "lm", se = FALSE, color = "#FF4040",
linetype = "dashed", size = 0.7) +
geom_vline(xintercept = 24.5, size = 0.8, alpha = 0.8) +
geom_line(aes(y = Poverty_funds),
color = "#FF0000", size = 1, alpha = 0.7) +
geom_line(aes(y = MLI), color = "#EF3EFF", size = 1,
alpha = 0.8) +
scale_fill_manual(name = "",values = c("bar.label" = "#0000FF")) +
scale_color_manual(name = "", values = c("line.label1" = "#FF0000", "line.label2" = "#EF3EFF",
"line.labeld" = "#FF4040"))
You usually can produce a legend by setting aes(color = column_title) in one of your geom layers. This code doesn't particularly make sense because you are referencing more than one y-axis without creating a second y-axis (a bad habit if you are trying to do so). Is there a way you can post more relevant code or a reproducible example so people can see exactly what you're trying to do?

Replace the mapping text in ggplotly() plot without breaking the plot

I am creating a stacked bar chart below using ggplot and I convert it to interactive using ggplotly(). As you can see in the screenshot below the pop up text when I hover over a bar shows as "Name" the correct "Name" of the relative bar-in that case- DCH. I tried to replace that with a name of my choice but then the whole chart breaks down. So basically I would like to know if I can use "Name" in the background in order to display the chart but display another Name instead. The same for all of the 5 bars.
The code chunk which is related with this is:
geom_col(mapping = aes(x = Name, y = count, fill = Class), width = rep(0.9,5),
color = "black", position = position_fill(reverse = T)) +
geom_text(size = 4, position = position_fill(reverse = T, vjust = 0.50), color = "black",
mapping = aes(x = Name, y = count, group = Class, label = round(count))) +
#DATA
Name<-c("DCH","DCH","DCH","DGI","DGI","DGI","LDP","LDP","LDP","RH","RH","RH","TC","TC","TC")
Class<-c("Class1","Class2","Overlap","Class1","Class2","Overlap","Class1","Class2","Overlap","Class1","Class2","Overlap","Class1","Class2","Overlap")
count<-c(2077,1642,460,1971,5708,566,2316,810,221,2124,3601,413,2160,1097,377)
FinalDF<-data.frame(Name, Class,count)
#PLOT
ggplotly(ggplot(data = FinalDF) +
geom_col(mapping = aes(x = Name, y = count, fill = Class), width = rep(0.9,5),
color = "black", position = position_fill(reverse = T)) +
geom_text(size = 4, position = position_fill(reverse = T, vjust = 0.50), color = "black",
mapping = aes(x = Name, y = count, group = Class, label = round(count))) +
annotate('text', size = 5, x = (5+1)/2, y = -0.1, label = c('A'), angle = 90) +
coord_flip() +
scale_fill_manual(values = c('lemonchiffon', 'palegreen3', 'deepskyblue2'),breaks=c("Class1", "Overlap", "Class2"), labels = c(paste("Unique to","DB"), "Overlap", "Unique to Comparison Dataset "),
guide = guide_legend(label.position = 'left', label.hjust = 0, label.vjust = 0.5)) )
The tooltip argument might be in the right direction.
library(sf)
library(plotly)
# Create the stacked bar plot using ggplot()
stackedBarPlot<- ggplot(data = FinalDF) +
geom_col(mapping = aes(x = Name, y = count, fill = Class), width = rep(0.9,5),
color = "black", position = position_fill(reverse = T)) +
geom_text(size = 4, position = position_fill(reverse = T, vjust = 0.50), color = "black",
mapping = aes(x = Name, y = count, group = Class, label = round(count))) +
annotate('text', size = 5, x = (5+1)/2, y = -0.1, label = c('A'), angle = 90) +
coord_flip() +
scale_fill_manual(values = c('lemonchiffon', 'palegreen3', 'deepskyblue2'),breaks=c("Class1", "Overlap", "Class2"), labels = c(paste("Unique to","DB"), "Overlap", "Unique to Comparison Dataset "),
guide = guide_legend(label.position = 'left', label.hjust = 0, label.vjust = 0.5))+
geom_sf(aes(fill=Class,text=paste(Name,"DB")))
stackedBarPlot%>%
ggplotly(tooltip = "text")

Complex Chart in R/ggplot with Proper Legend Display

This is my first question to StackExchange, and I've searched for answers that have been helpful, but haven't really gotten me to where I'd like to be.
This is a stacked bar chart, combined with a point chart, combined with a line.
Here's my code:
theme_set(theme_light())
library(lubridate)
FM <- as.Date('2018-02-01')
x.range <- c(FM - months(1) - days(1) - days(day(FM) - 1), FM - days(day(FM) - 1) + months(1))
x.ticks <- seq(x.range[1] + days(1), x.range[2], by = 2)
#populate example data
preds <- data.frame(FM = FM, DATE = seq(x.range[1] + days(1), x.range[2] - days(1), by = 1))
preds <- data.frame(preds, S_O = round(seq(1, 1000000, by = 1000000/nrow(preds))))
preds <- data.frame(preds, S = round(ifelse(month(preds$FM) == month(preds$DATE), day(preds$DATE) / 30.4, 0) * preds$S_O))
preds <- data.frame(preds, O = preds$S_O - preds$S)
preds <- data.frame(preds, pred_sales = round(1000000 + rnorm(nrow(preds), 0, 10000)))
preds$ma <- with(preds, stats::filter(pred_sales, rep(1/5, 5), sides = 1))
y.max <- ceiling(max(preds$pred_sales) / 5000) * 5000 + 15000
line.cols <- c(O = 'palegreen4', S = 'steelblue4',
P = 'maroon', MA = 'blue')
fill.cols <- c(O = 'palegreen3', S = 'steelblue3',
P = 'red')
p <- ggplot(data = preds,
mapping = aes(DATE, pred_sales))
p <- p +
geom_bar(data = reshape2::melt(preds[,c('DATE', 'S', 'O')], id.var = 'DATE'),
mapping = aes(DATE, value, group = 1, fill = variable, color = variable),
width = 1,
stat = 'identity',
alpha = 0.5) +
geom_point(mapping = aes(DATE, pred_sales, group = 2, fill = 'P', color = 'P'),
shape = 22, #square
alpha = 0.5,
size = 2.5) +
geom_line(data = preds[!is.na(preds$ma),],
mapping = aes(DATE, ma, group = 3, color = 'MA'),
alpha = 0.8,
size = 1) +
geom_text(mapping = aes(DATE, pred_sales, label = formatC(pred_sales / 1000, format = 'd', big.mark = ',')),
angle = 90,
size = 2.75,
hjust = 1.25,
vjust = 0.4) +
labs(title = sprintf('%s Sales Predictions - %s', 'Overall', format(FM, '%b %Y')),
x = 'Date',
y = 'Volume in MMlbs') +
theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1, size = 8),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
legend.title = element_blank(),
legend.position = 'bottom',
legend.text = element_text(size = 8),
legend.margin = margin(t = 0.25, unit = 'cm')) +
scale_x_date(breaks = x.ticks,
date_labels = '%b %e',
limits = x.range) +
scale_y_continuous(limits = c(0, y.max),
labels = function(x) { formatC(x / 1000, format='d', big.mark=',') }) +
scale_color_manual(values = line.cols,
breaks = c('MA'),
labels = c(MA = 'Mvg Avg (5)')) +
scale_fill_manual(values = fill.cols,
breaks = c('P', 'O', 'S'),
labels = c(O = 'Open Orders', S = 'Sales', P = 'Predictions'))
p
The chart it generates is this:
As you can see, the legend does a couple of funky things. It's close, but not quite there. I only want boxes with exterior borders for Predictions, Open Orders, and Sales, and only a blue line for the Mvg Avg (5).
Any advice would be appreciated.
Thanks!
Rather late, but if you are still interested to understand this problem, the following should work. Explanations are included as comments within the code:
library(dplyr)
preds %>%
# scale the values for ALL numeric columns in the dataset, before
# passing the dataset to ggplot()
mutate_if(is.numeric, ~./1000) %>%
# since x / y mappings are stated in the top level ggplot(), there's
# no need to repeat them in the subsequent layers UNLESS you want to
# override them
ggplot(mapping = aes(x = DATE, y = pred_sales)) +
# 1. use data = . to inherit the top level data frame, & modify it on
# the fly for this layer; this is neater as you are essentially
# using a single data source for the ggplot object.
# 2. geom_col() is a more succinct way to say geom_bar(stat = "identity")
# (I'm using tidyr rather than reshape package, since ggplot2 is a
# part of the tidyverse packages, & the two play together nicely)
geom_col(data = . %>%
select(S, O, DATE) %>%
tidyr::gather(variable, value, -DATE),
aes(y = value, fill = variable, color = variable),
width = 1, alpha = 0.5) +
# don't show legend for this layer (o/w the fill / color legend would
# include a square shape in the centre of each legend key)
geom_point(aes(fill = 'P', color = 'P'),
shape = 22, alpha = 0.5, size = 2.5, show.legend = FALSE) +
# use data = . %>% ... as above.
# since the fill / color aesthetic mappings from the geom_col layer would
# result in a border around all fill / color legends, avoid it all together
# here by hard coding the line color to "blue", & map its linetype instead
# to create a separate linetype-based legend later.
geom_line(data = . %>% na.omit(),
aes(y = ma, linetype = 'MA'),
color = "blue", alpha = 0.8, size = 1) +
# scales::comma is a more succinct alternative to formatC for this use case
geom_text(aes(label = scales::comma(pred_sales)),
angle = 90, size = 2.75, hjust = 1.25, vjust = 0.4) +
labs(title = sprintf('%s Sales Predictions - %s', 'Overall', format(FM, '%b %Y')),
x = 'Date',
y = 'Volume in MMlbs') +
theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1, size = 8),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
legend.title = element_blank(),
legend.position = 'bottom',
legend.text = element_text(size = 8),
legend.margin = margin(t = 0.25, unit = 'cm')) +
scale_x_date(breaks = x.ticks,
date_labels = '%b %e',
limits = x.range) +
# as above, scales::comma is more succinct
scale_y_continuous(limits = c(0, y.max / 1000),
labels = scales::comma) +
# specify the same breaks & labels for the manual fill / color scales, so that
# a single legend is created for both
scale_color_manual(values = line.cols,
breaks = c('P', 'O', 'S'),
labels = c(O = 'Open Orders', S = 'Sales', P = 'Predictions')) +
scale_fill_manual(values = fill.cols,
breaks = c('P', 'O', 'S'),
labels = c(O = 'Open Orders', S = 'Sales', P = 'Predictions')) +
# create a separate line-only legend using the linetype mapping, with
# value = 1 (i.e. unbroken line) & specified alpha / color to match the
# geom_line layer
scale_linetype_manual(values = 1,
label = 'Mvg Avg (5)',
guide = guide_legend(override.aes = list(alpha = 1,
color = "blue")))

Resources