Related
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='')
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.
I have a data.table that I want to plot
cbo = data.table(date = seq(as.Date("2000/4/2"), by = "week", length.out = 9), week = 1:9, x= sample(10000:50000, 9))
Week 6 to 9 forecasts. I want a dotted line from 2000-05-07 onward to signify the forecasts and shade the background in blue.
My ggplot2
ggplot(cbo) +
aes(x = date, y = x) +
geom_line(size = 0.5, colour = "#112446") +
theme_minimal()
Question: How do I dot the line from week == 6, date = 2000-05-07 and shade background in blue colour to distinguish the forecasted numbers?
I think this should accomplish what you're looking to do. I used geom_rect to shade the plot and an ifelse to adjust the linetype in the aes of geom_segment. If you just use geom_line you'll end up with a gap between the dates for week 5 and 6.
library(ggplot2)
library(data.table)
# make data
cbo <- data.table(date = seq(as.Date("2000/4/2"), by = "week", length.out = 9), week = 1:9, x= sample(10000:50000, 9))
# plot data
ggplot(cbo) +
geom_segment(aes(x = date, xend = lead(date), y = x, yend = lead(x),
linetype = ifelse(date > as.Date("2000-04-30"), "solid", "dashed")), # adjust linetype
size = 1) +
# plot a rectangle
geom_rect(aes(xmin = as.Date("2000-05-07"), xmax = as.Date("2000-05-30"), ymin = min(x), ymax = Inf),
fill = "blue", alpha = 0.1)+ # adjust alpha for shading
theme_minimal() +
theme(legend.position = 'none')
You can plot geom_line twice. Once with a solid line until week 6 and once with a dotted line for the whole line.
library(tidyverse)
library(data.table)
cbo = data.table(date = seq(as.Date("2000/4/2"), by = "week", length.out = 9), week = 1:9, x= sample(10000:50000, 9))
ggplot(cbo) +
aes(x = date, y = x) +
geom_rect(aes(xmin = as.Date("2000-05-07"), xmax = as.Date("2000-05-28"), ymin = -Inf, ymax = Inf),
fill = "#6BC6F5FF", alpha = 0.1) +
geom_line(size = 0.5, colour = "#112446", lty = 2) +
geom_line(data = cbo %>% filter(week <= 6), size = 0.7, color = "#112446", lty = 1) +
theme_minimal()
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")
I mean, I'd want to paint only the square area P1 X (Q1-Q2).
Not the trapezoid (P2+P1) X (Q1-Q2/2).
Here's code that I used. I used ggplot and dplyr. How can I solve this problem?
How can I paint the only square area not the trapezoied area!!!!
library(ggplot2)
library(dplyr)
supply <- Hmisc::bezier(x = c(1, 8, 9),
y = c(1, 5, 9)) %>%
as_data_frame()
demand <- Hmisc::bezier(c(1, 3, 9),
c(9, 3, 1)) %>%
as_data_frame()
fun_supply <- approxfun(supply$x, supply$y, rule = 2)
fun_supply(c(2, 6, 8))
fun_demand <- approxfun(demand$x, demand$y, rule = 2)
intersection_funs <- uniroot(function(x) fun_supply(x) - fun_demand(x), c(1, 9))
intersection_funs
y_root <- fun_demand(intersection_funs$root)
curve_intersect <- function(curve1, curve2) {
# Approximate the functional form of both curves
curve1_f <- approxfun(curve1$x, curve1$y, rule = 2)
curve2_f <- approxfun(curve2$x, curve2$y, rule = 2)
# Calculate the intersection of curve 1 and curve 2 along the x-axis
point_x <- uniroot(function(x) curve1_f(x) - curve2_f(x),
c(min(curve1$x), max(curve1$x)))$root
# Find where point_x is in curve 2
point_y <- curve2_f(point_x)
# Finish
return(list(x = point_x, y = point_y))
}
intersection_xy <- curve_intersect(supply, demand)
intersection_xy
intersection_xy_df <- intersection_xy %>% as_data_frame()
demand2 <- Hmisc::bezier(c(1.5, 3.5, 9.5),
c(9.5, 3.5, 1.5)) %>%
as_data_frame()
supply2 <- Hmisc::bezier(c(1,7,8),
c(3,7,11)) %>%
as_data_frame()
#Make a data frame of the intersections of the supply curve and both demand curves
intersections <- bind_rows(curve_intersect(supply, demand),
curve_intersect(supply2, demand2))
plot_labels <- data_frame(label = c("S", "D","S[1]","D[1]"),
x = c(9, 1, 6.5, 3),
y = c(8, 8, 8, 8))
ggplot(mapping = aes(x = x, y = y)) +
geom_path(data = supply, color = "#0073D9", size = 1, linetype = "dashed") +
geom_path(data = demand, color = "#FF4036", size = 1, linetype = "dashed") +
geom_path(data = demand2, color = "#FF4036", size = 1) +
geom_path(data = supply2, color = "#0073D9", size = 1) +
geom_segment(data = intersections,
aes(x = x, y = 0, xend = x, yend = y), lty = "dotted") +
geom_segment(data = intersections,
aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") +
geom_segment(data = intersections,
aes(x = x, y = y, xend = x, yend= y), lty = "dotted") +
geom_point(data = intersections, size = 3) +
geom_text(data = plot_labels,
aes(x = x, y = y, label = label), parse = TRUE) +
scale_x_continuous(expand = c(0, 0), breaks = intersections$x,
labels = expression(Q[1], Q[2])) +
scale_y_continuous(expand = c(0, 0), breaks = intersections$y,
labels = expression(P[1], P[2]))+
labs(x = "Quantity", y = "Price") +
geom_area(data =intersections, fill="#9999FF", alpha=0.5) +
theme_classic() +
coord_equal()
Could you help me to paint the area that I mentioned.
You might try adding geom_rect(data=intersections[1,], aes(xmin=0, xmax=x, ymin=0, ymax=y),fill='green', alpha=0.5) to your plot call.
So we have:
ggplot(mapping = aes(x = x, y = y)) +
geom_path(data = supply, color = "#0073D9", size = 1, linetype = "dashed") +
geom_path(data = demand, color = "#FF4036", size = 1, linetype = "dashed") +
geom_path(data = demand2, color = "#FF4036", size = 1) +
geom_path(data = supply2, color = "#0073D9", size = 1) +
geom_segment(data = intersections,
aes(x = x, y = 0, xend = x, yend = y), lty = "dotted") +
geom_segment(data = intersections,
aes(x = 0, y = y, xend = x, yend = y), lty = "dotted") +
geom_segment(data = intersections,
aes(x = x, y = y, xend = x, yend= y), lty = "dotted") +
geom_point(data = intersections, size = 3) +
geom_text(data = plot_labels,
aes(x = x, y = y, label = label), parse = TRUE) +
scale_x_continuous(expand = c(0, 0), breaks = intersections$x,
labels = expression(Q[1], Q[2])) +
scale_y_continuous(expand = c(0, 0), breaks = intersections$y,
labels = expression(P[1], P[2]))+
labs(x = "Quantity", y = "Price") +
geom_area(data =intersections, fill="#9999FF", alpha=0.5) +
theme_classic() +
coord_equal()+
geom_rect(data=intersections[1,], aes(xmin=0, xmax=x, ymin=0, ymax=y),fill='green', alpha=0.5)
Edit based on comment:
geom_rect(data=intersections, aes(xmin=x[2], xmax=x[1], ymin=0, ymax=y[1]),fill='green', alpha=0.5)
Though the answer from J Con is in depth and does provide a solution, a cleaner approach in ggplot2 may be to use the annotate function, with geom and other arguments set appropriately. (See link for help page.)
This is because using something like geom_rect involves passing positions and so on as a data.frame, which is a bit more of a hack as, conceptually, from a grammar of graphics perspective, the data layer and the annotation layer are distinct: the act of mapping data variables to graphical aesthetics in a systematic and objective way, and of marking up features within the dataset in a piecemeal and subjective way, are separate activities, and using annotate explicitly for the latter purpose makes this divide clearer in terms of the code and concepts.
Edit
To be more specific, the annotate equivalent of the following:
geom_rect(data=intersections, aes(xmin=x[2], xmax=x[1], ymin=0, ymax=y[1]),fill='green', alpha=0.5)
Would likely be as follows
annotate(
geom = "rect",
xmin = intersections$x[2], x = intersections$x[1],
ymin = 0, ymax = intersections$y[1],
fill = 'green', alpha = 0.5
)
Functionally this is exactly the same, but conceptually it makes the separation between the data layer and the annotation layer much clearer in the code expressed.
Note: Annotate could also be used for the points and text.