Geom_label_repel not properly referencing to the sec.axis - r

I am working with a ggplot that has two axis: one for the geom_bar component, and the other for the geom_linecomponent. And for this, I am using the sec.axis() command.
I wanted to insert a box to provide the last value of the geom_line component, but I am struggling because I believe that while using the commmand geom_label_repel, the aesthetic being used, is referent to the geom_barcomponent.
I'll provide a similar data to illustrate what I am saying.
df <- data.frame(day = as.character(seq(from = 1, to = 100, by = 1)),
total = rbinom(n=100,30,0.5),
prop = runif(100))
df <- df %>% arrange(df, by = day)
df$`percentage` <- label_percent(accuracy = 0.01)(df$prop)
ggplot(data = df,
aes(x = day, y = total)) +
geom_bar(stat = "identity", fill = "lightgreen", width = 0.35) +
geom_line(data = df,
aes(x = day, y = (prop)*15, group = 1),
color = "red", size = 1,inherit.aes = TRUE) +
scale_y_continuous(
labels = function(x) format(x, scientific = FALSE),
#breaks = seq(from = 0, to = 10000000,by = 100000),
sec.axis = sec_axis(trans = ~./15,
name = "Secondary axis",
breaks = seq(from = 0, to = 10, by = 0.1),
scales::percent))+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5))+
geom_label_repel(data=df[nrow(df),],
aes(x = day,
y = prop*1,
label = round(prop*100,2)),
color = 'red',
segment.alpha = 0.5) +
scale_x_discrete(expand = expansion(add = c(0, 7)))
Which outputs the following image:
As you can tell, it works well in regards to obtaining the last number of the prop column, which is intended, but it is not automatically placed beside the geom_line.
I have tried messing with the nudge_xand nudge_y commands but it didn't lead me to anywhere, given the fact that I want to have this "number placement" automatic.
Can anyone help?

The sec.axis is in some ways just decorative. ggplot is plotting everything by the main axis. To make the label follow the line, make the same transform as in your geom_line call (y = prop*15):
library(tidyverse)
library(ggrepel)
df <- data.frame(day = as.character(seq(from = 1, to = 100, by = 1)),
total = rbinom(n=100,30,0.5),
prop = runif(100))
df <- df %>% arrange(df, by = day)
df$`percentage` <- scales::label_percent(accuracy = 0.01)(df$prop)
ggplot(data = df,
aes(x = day, y = total)) +
geom_bar(stat = "identity", fill = "lightgreen", width = 0.35) +
geom_line(data = df,
aes(x = day, y = (prop)*15, group = 1),
color = "red", size = 1,inherit.aes = TRUE) +
scale_y_continuous(
labels = function(x) format(x, scientific = FALSE),
#breaks = seq(from = 0, to = 10000000,by = 100000),
sec.axis = sec_axis(trans = ~./15,
name = "Secondary axis",
breaks = seq(from = 0, to = 10, by = 0.1),
scales::percent))+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5))+
geom_label_repel(data=df[nrow(df),],
aes(x = day,
y = prop*15,
label = round(prop*100,2)),
color = 'red',
segment.alpha = 0.5) +
scale_x_discrete(expand = expansion(add = c(0, 7)))
#> Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
#> ℹ Please use `linewidth` instead.

Related

Legend for a plot with sec.axis (geom bar + geom line)

I have a ggplot with two y-axes by the sec.axis command, and I've been struggling with handling legends in these situations.
The code:
library(ggplot2)
library(ggrepel)
df <- data.frame(day = as.character(seq(from = 1, to = 100, by = 1)),
total = rbinom(n=100,30,0.5),
prop = runif(100))
df <- df %>% arrange(df, by = day)
df$`percentage` <- label_percent(accuracy = 0.01)(df$prop)
ggplot(data = df,
aes(x = day, y = total)) +
geom_bar(aes(x = day, y = total), stat = "identity", fill = "lightgreen", width = 0.35) +
geom_line(data = df,
aes(x = day, y = (prop)*15, group = 1, color = prop),
color = "red", size = 1,inherit.aes = TRUE) +
scale_y_continuous(
labels = function(x) format(x, scientific = FALSE),
#breaks = seq(from = 0, to = 10000000,by = 100000),
sec.axis = sec_axis(trans = ~./15,
name = "Secondary axis",
breaks = seq(from = 0, to = 10, by = 0.1),
scales::percent))+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5))+
geom_label_repel(data=df[nrow(df),],
aes(x = day,
y = prop*15,
label = round(prop*100,2)),
color = 'red',
nudge_x = 2,
segment.alpha = 0.5) +
scale_x_discrete(expand = expansion(add = c(0, 7)))
And I wanted to simply have the legend, instead of having the axis description, like this:
I know it seems reasonably easy to obtain, but given the fact that I don’t have any groups, I either: can't plot any legend what so ever; or I get plotted two squares (when I wanted the legend to consist of a line, with the geom_line color and a square with the geom_bar color).
With the code #divibisan provided, I get the following output:
Final update:
I finally found the solution. I still have no idea how I got a different output from what #divibisan posted, but here goes what worked for me:
library(dplyr)
library(ggplot2)
library(ggrepel)
df <- data.frame(day = as.character(seq(from = 1, to = 100, by = 1)),
total = rbinom(n=100,30,0.5),
prop = runif(100))
df <- df %>% arrange(df, by = day)
df$`percentage` <- scales::label_percent(accuracy = 0.01)(df$prop)
ggplot(data = df,
aes(x = day, y = total)) +
geom_bar(aes(x = day, y = total, fill = "Total"), stat = "identity", width = 0.35) +
geom_line(data = df,
aes(x = day, y = (prop)*15, group = 1, color = 'Percentage'), size = 1,inherit.aes = TRUE) +
scale_y_continuous(
labels = function(x) format(x, scientific = FALSE),
#breaks = seq(from = 0, to = 10000000,by = 100000),
sec.axis = sec_axis(trans = ~./15,
name = "Secondary axis",
breaks = seq(from = 0, to = 10, by = 0.1),
scales::percent))+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5))+
geom_label_repel(data=df[nrow(df),],
aes(x = day,
y = prop*15,
label = round(prop*100,2)),
color = 'red',
nudge_x = 2,
segment.alpha = 0.5) +
scale_x_discrete(expand = expansion(add = c(0, 7))) +
scale_fill_manual(values=c('Total' = 'lightgreen'), drop=TRUE, name='') +
scale_color_manual(values=c('Percentage' = "red"), drop=TRUE, name='') +
theme(legend.title = element_blank())
You just need to set the color/fill with a value in the aes, then use a scale function to set the color and create a legend. Here, we move the color= and fill= values from the bar and line into the aes. Then we add scale_fill/color_manual functions that set the color based on those names:
library(dplyr)
library(ggplot2)
library(ggrepel)
df <- data.frame(day = as.character(seq(from = 1, to = 100, by = 1)),
total = rbinom(n=100,30,0.5),
prop = runif(100))
df <- df %>% arrange(df, by = day)
df$`percentage` <- scales::label_percent(accuracy = 0.01)(df$prop)
ggplot(data = df,
aes(x = day, y = total)) +
geom_bar(aes(x = day, y = total, fill = "Total"), stat = "identity", width = 0.35) +
geom_line(data = df,
aes(x = day, y = (prop)*15, group = 1, color = 'Percentage'), size = 1,inherit.aes = TRUE) +
scale_y_continuous(
labels = function(x) format(x, scientific = FALSE),
#breaks = seq(from = 0, to = 10000000,by = 100000),
sec.axis = sec_axis(trans = ~./15,
name = "Secondary axis",
breaks = seq(from = 0, to = 10, by = 0.1),
scales::percent))+
theme(axis.text.x = element_text(angle = 90, vjust = 0.5))+
geom_label_repel(data=df[nrow(df),],
aes(x = day,
y = prop*15,
label = round(prop*100,2)),
color = 'red',
nudge_x = 2,
segment.alpha = 0.5) +
scale_x_discrete(expand = expansion(add = c(0, 7))) +
scale_fill_manual(values=c('Total' = 'lightgreen', 'Percentage'='red'), drop=TRUE, name='') +
scale_color_manual(values=c('Total' = 'lightgreen', 'Percentage'='red'), drop=TRUE, name='')
If, for some reason, the drop argument isn't working and both colors show up in both scales, there's really no reason to include them in the scale if they're not expected to be there. Just only include the colors in the scale that are desired:
scale_fill_manual(values=c('Total' = 'lightgreen'), drop=TRUE, name='') +
scale_color_manual(values=c('Percentage'='red'), drop=TRUE, name='')

How to arrange data visualization in geom_segment() in a decreasing order?

I was trying to plot tweets' sources/devices in a decreasing order using ggplot/geom_segment in R.
Here is the code I ran:
ggplot(data = device, mapping = aes(x = fct_reorder(as.factor(source), n), y = n)) +
geom_segment(aes(x = source, xend = source, y = 0, yend = n)) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, family = "sans")) +
labs(title = "Tweets by device/source", x = "device/source", y = "frequency") +
geom_point(size = 4, color = "red", fill = alpha("yellow", 0.3), alpha = 0.7, shape = 21, stroke = 2)
Here is the plot it returned, which is not in decreasing pattern as I wanted to be.
So, I was wondering how could I plot the geom_segment in decreasing order?
You used the correct approach, but at the wrong spot. Try to do the factor rearrangement on your data before the ggplot call. In your case you did the reordering, but then used the original "source" data and not the reordered one in geom_segment. Doing the reordering before the ggplot call fixes that.
Here is an example using the mtcars dataset:
mtcars %>%
rownames_to_column("model") %>%
as_tibble() %>%
mutate(model = fct_reorder(model, -mpg)) %>%
ggplot() +
geom_segment(aes(x = model, xend = model, y = 0, yend = mpg)) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, family = "sans")) +
labs(title = "Tweets by device/source", x = "device/source", y = "frequency") +
geom_point(aes(x = model, y = mpg), size = 4, color = "red", fill = alpha("yellow", 0.3), alpha = 0.7, shape = 21, stroke = 2)
The new plot looks like this:
The improved code:
device %>%
as_tibble() %>%
mutate(source = fct_reorder(source, -n)) %>%
ggplot() +
geom_segment(aes(x = source, xend = source, y = 0, yend = n)) +
theme(axis.text.x = element_text(angle = 90, hjust = 1, family = "sans", size = 10)) +
labs(title = "Tweets by device/source", x = "device/source", y = "frequency") +
geom_point(aes(x = source, y = n), size = 3, color = "red", fill =
alpha("yellow", 0.3), alpha = 0.7, shape = 21, stroke = 2)

how to ggplot with upper and lower bound as shaded using facet_wrap in R?

I am trying to automate the process of plotting data using ggplot and the facet_wrap functionality. I want a single y-axis label instead individual plot Ob (i.e., A_Ob, B_ob etc) and also a single X-axis not all the plots having label for x-axis such as below. Below is my sample code using gridextra package. However, i would like to do it through facet_wrap as i have many other plots to draw which i think will save me sometime.
graphics.off()
rm(list = ls())
library(tidyverse)
library(gridExtra)
G1 = data.frame(A_Ob = runif(1000, 5, 50), A_Sim = runif(1000, 3,60), A_upper = runif(1000, 10,70), A_lower = runif(1000, 0, 45 ),
B_Ob = runif(1000, 5, 50), B_Sim = runif(1000, 3,60), B_upper = runif(1000, 10,70), B_lower = runif(1000, 0, 45 ),
C_Ob = runif(1000, 5, 50), C_Sim = runif(1000, 3,60), C_upper = runif(1000, 10,70), C_lower = runif(1000, 0, 45 ),
D_Ob = runif(1000, 5, 50), D_Sim = runif(1000, 3,60), D_upper = runif(1000, 10,70), D_lower = runif(1000, 0, 45 ),
Pos = 1:1000)
A1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = A_Ob), col = "black")+
geom_line(aes(y = A_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = A_upper, ymax = A_lower), fill = "grey70")
B1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = B_Ob), col = "black")+
geom_line(aes(y = B_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = B_upper, ymax = B_lower), fill = "grey70")
C1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = C_Ob), col = "black")+
geom_line(aes(y = C_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = C_upper, ymax = C_lower), fill = "grey70")
D1 = ggplot(data = G1, aes(x = Pos))+
geom_line(aes(y = D_Ob), col = "black")+
geom_line(aes(y = D_Sim), col = "blue")+
geom_vline(xintercept = 750, color = "red", size=1.5)+
geom_ribbon(aes(ymin = D_upper, ymax = D_lower), fill = "grey70")
grid.arrange(A1,B1,C1,D1, nrow = 4)
Here is the result of the code
You need to reshape your dataframe into a longer format and separate values for Ob, Sim, upper and lower.
Using the function melt from data.table package can help you to achieve this:
library(data.table)
setDT(G1)
Ob_cols = grep("_Ob",colnames(G1),value = TRUE)
Sim_cols = grep("_Sim",colnames(G1),value = TRUE)
Upper_cols = grep("_upper",colnames(G1), value = TRUE)
Lower_cols = grep("_lower", colnames(G1), value = TRUE)
g.m <- melt(G1, measure = list(Ob_cols,Sim_cols,Upper_cols,Lower_cols), value.name = c("OBS","SIM","UP","LOW"))
levels(g.m$variable) <- c("A","B","C","D")
Pos variable OBS SIM UP LOW
1: 1 A 5.965488 29.167666 26.66783 29.97259
2: 2 A 23.855719 8.570245 43.75830 30.65616
3: 3 A 16.947887 51.201047 15.20758 39.76122
4: 4 A 49.883306 3.715319 34.38066 20.73177
5: 5 A 5.021938 3.102880 30.05036 32.05123
6: 6 A 19.887176 15.400853 53.67156 28.54982
and now, you can plot it:
library(ggplot2)
ggplot(g.m, aes(x = Pos))+
geom_line(aes(y = OBS), color = "black")+
geom_line(aes(y = SIM), color = "blue")+
geom_vline(xintercept = 750,color = "red", size = 1.5)+
geom_ribbon(aes(ymin = UP, ymax = LOW), fill = "grey70")+
facet_grid(variable~.)
EDIT: Adding annotations & renaming labels
To rename and replace facet labels, you can re-define levels of variable and use facet_wrap instead of facet_grid using ncol = 1 as argument.
To add multiple annotations on a single panel, you need to define a dataframe that you will use in geom_text.
Altogether, you have to do:
# renaming names of each facets:
levels(g.m$variable) <- c("M1","M2","M3","M4")
# Defining annotations to add:
df_text <- data.frame(label = c("Calibration", "Validation"),
x = c(740,760),
y = c(65,65),
hjust = c(1,0),
variable = factor("M1", levels = c("M1","M2","M3","M4")))
# Plotting
ggplot(g.m, aes(x = Pos))+
geom_line(aes(y = OBS), color = "black")+
geom_line(aes(y = SIM), color = "blue")+
geom_vline(xintercept = 750,color = "red", size = 1.5)+
geom_ribbon(aes(ymin = UP, ymax = LOW), fill = "grey70")+
facet_wrap(variable~., ncol = 1)+
theme(strip.text.x = element_text(hjust = 0),
strip.background = element_rect(fill = "white"))+
geom_text(data = df_text, aes(x = x, y = y, label = label, hjust = hjust), color = "red")
Does it look what you are expecting ?

Drawing elements (arrows & circle) in ggplot (R) to show the difference between two bars

I am trying to create a plot in R using ggplot that shows the difference between my two bars in a nice way.
I found an example that did part of what I wanted, but I have two major problems:
It is based on comparing groups of bars, but I only have two, so I added one group with both of them.
I would like to draw the arrow in nicer shape. I attached an image.
Code:
transactions <- c(5000000, 1000000)
time <- c("Q1","Q2")
group <- c("A", "A")
data <- data.frame(transactions, time, group)
library(ggplot2)
fun.data <- function(x){
print(x)
return(data.frame(y = max(x) + 1,
label = paste0(round(diff(x), 2), "cm")))
}
ylab <- c(2.5, 5.0, 7.5, 10)
gg <- ggplot(data, aes(x = time, y = transactions, fill = colors_hc[1], label = round(transactions, 0))) +
geom_bar(stat = "identity", show.legend = FALSE) +
geom_text(position = position_dodge(width = 0.9),
vjust = 1.1) +
geom_line(aes(group = group), position = position_nudge(0.1),
arrow = arrow()) +
stat_summary(aes(x = group, y = transactions),
geom = "label",
fun.data = fun.data,
fontface = "bold", fill = "lightgrey",
inherit.aes = FALSE) +
expand_limits(x = c(0, NA), y = c(0, NA)) +
scale_y_continuous(labels = paste0(ylab, "M"),
breaks = 10 ^ 6 * ylab)
gg
The arrows I am aiming for:
Where I am (ignore the ugliness, didn't style it yet):
This works, but you still need to play around a bit with the axes (or rather beautify them)
library(dplyr)
library(ggplot2)
transactions <- c(5000000, 1000000)
time <- c("Q1","Q2")
group <- c("A", "A")
my_data <- data.frame(transactions, time, group)
fun.data <- function(x){
return(data.frame(y = max(x) + 1,
label = as.integer(diff(x))))
}
my_data %>%
ggplot(aes(x = group, y = transactions, fill = time)) +
geom_bar(stat = 'identity', position = 'dodge') +
geom_text(aes(label = as.integer(transactions)),
position = position_dodge(width = 0.9),
vjust = 1.5) +
geom_line(aes(group = group), position = position_nudge(0.1),
arrow = arrow()) +
stat_summary(aes(x = group, y = transactions),
geom = "label",
size = 5,
position = position_nudge(0.05),
fun.data = fun.data,
fontface = "bold", fill = "lightgrey",
inherit.aes = FALSE)
Edit2:
y_limit <- 6000000
my_data %>%
ggplot(aes(x = time, y = transactions)) +
geom_bar(stat = 'identity',
fill = 'steelblue') +
geom_text(aes(label = as.integer(transactions)),
vjust = 2) +
coord_cartesian(ylim = c(0, y_limit)) +
geom_segment(aes(x = 'Q1', y = max(my_data$transactions),
xend = 'Q1', yend = y_limit)) +
geom_segment(aes(x = 'Q2', y = y_limit,
xend = 'Q2', yend = min(my_data$transactions)),
arrow = arrow()) +
geom_segment(aes(x = 'Q1', y = y_limit,
xend = 'Q2', yend = y_limit)) +
geom_label(aes(x = 'Q2',
y = y_limit,
label = as.integer(min(my_data$transactions)- max(my_data$transactions))),
size = 10,
position = position_nudge(-0.5),
fontface = "bold", fill = "lightgrey")

How to show percent labels on histogram bars using ggplot2

I have seen lots of question regarding converting count on y axis into percent but must of them are in bar plot.
I want to do similar thing in histogram but not able to show the labels on the bar clearly. Please tell me where I am doing wrong.
x = runif(100, min = 0, max = 10)
data1 <- data.frame(x = x)
ggplot(aes(x = x), data = data1)+
geom_histogram(aes(y = (..count..)/sum(..count..)), bins = 10, breaks =
seq(0,10,1), fill = "blue", col = "black")+
geom_text(aes(y = ((..count..)/sum(..count..)),
label = scales::percent((..count..)/sum(..count..))),
stat = "count", vjust = -10)+
scale_y_continuous(labels = scales::percent)
Output:
Use scale_y_continous with breaks and labels will solve your problem.
data1 <- data.frame (x = runif(100, min = 0, max = 10))
ggplot(aes(x=x), data1) + stat_bin(aes(y = ..count..))
ggplot(data1, aes(x = x)) + geom_histogram(fill = "blue", col = "black")+ scale_y_continuous(breaks = seq(0,10,1),labels = paste(seq(0, 10, by = 1) / 100, "%", sep = ""))+geom_text(aes(y = (..count..),label = scales::percent((..count..)/sum(..count..))), stat="bin",colour="green",vjust=2)
or, you can specify where you would like to add the percentage like this:
geom_text(aes(y = (..count..)+0.5))
of course you can change the color as well. from,
stat="bin",colour="your prefer color "
Also you can change the width of the bins as follows:
geom_histogram(fill = "blue", col = "black", binwidth = 0.5)

Resources