Based on the code below how can I adjust the title such that it does not get trimmed.
Data (df):
structure(list(year = 1980:2021, AvgTMean = c(24.2700686838937,
23.8852956598276, 25.094446596092, 24.1561175050287, 24.157183605977,
24.3047482638362, 24.7899738481466, 24.5756232655603, 24.5833086228592,
24.7344695534483, 25.3094451071121, 25.2100615173707, 24.3651692293534,
24.5423890611494, 25.2492166633908, 24.7005097837931, 24.2491591827443,
25.0912281781322, 25.0779264303305, 24.403294248319, 24.4983991453592,
24.4292324356466, 24.8179824927011, 24.7243948463075, 24.5086534543966,
24.2818632071983, 24.4567195220259, 24.8402224356034, 24.6574465515086,
24.5440715673563, 23.482670620977, 24.9979594684914, 24.5452453980747,
24.9271462811494, 24.7443215819253, 25.8929839790805, 25.1801908261063,
25.2079308058908, 25.0722425561207, 25.4554644289799, 25.4548979078736,
25.0756772250287), AvgTMin = c(19.6018663372126, 18.9935718486724,
20.8351710187356, 19.7723002680316, 19.8097384811782, 19.7280847671034,
20.2907499842098, 20.1950373662931, 20.1812715311494, 20.1808865070833,
21.0320272801006, 21.1252427976293, 20.1712830368678, 20.407655174727,
21.5430646243391, 20.6760574525862, 20.0822658237356, 21.0735574619397,
21.0871494406322, 20.1311178414224, 20.3191250001149, 20.3474683732557,
20.668169553204, 20.3772270269296, 20.2330157893678, 19.9486551337931,
20.1114496908333, 20.5816350393966, 20.4033879191236, 20.1582514856897,
19.2288879223678, 20.8451063140805, 20.4878865041092, 21.0259712576437,
20.5510100674138, 22.0143793370977, 21.3529094881753, 21.1688506012213,
21.040550304569, 21.4923981385632, 21.6580430460057, 21.2433069288506
), AvgTMax = c(28.9392198638937, 28.778245693046, 29.3549223685201,
28.5411393752011, 28.5058118063649, 28.8825532046983, 29.2903534709195,
28.9574051835776, 28.9865201368247, 29.2891997662069, 29.5881379007328,
29.2960976760201, 28.5602557685057, 28.6782844806753, 28.9566034394684,
28.7262054694971, 28.4171896994397, 29.1100747038649, 29.0698836095546,
28.6766350461063, 28.6788764437787, 28.5122026355891, 28.9690143596839,
29.0727844759914, 28.7854971337931, 28.6163189712069, 28.8032270024138,
29.1000460207471, 28.9127356101149, 28.9310646744109, 27.7376810545833,
29.1520129070402, 28.6037845089512, 28.8295359311638, 28.9388276133764,
29.7726939654598, 29.0086407880029, 29.2482097613937, 29.1050890698132,
29.4187571974569, 29.2519238543247, 28.9081913630029)), class = "data.frame", row.names = c(NA,
-42L))
Code:
library(tidyverse)
library(plotly)
AvgTMeanYearFP = ggplot(df, aes(year, AvgTMean)) +
geom_smooth(method = 'lm', fullrange = TRUE) +
annotate('rect', xmin = -Inf, xmax = 2021, ymin = -Inf, ymax = Inf,
fill = 'gray92') +
geom_vline(xintercept = seq(1980, 2020, 5), color = 'white') +
geom_hline(yintercept = seq(23.5, 25.5, 0.5), color = 'white') +
geom_line() +
scale_x_continuous(limits = c(1980, 2030)) +
labs(y = "Avg. Mean T (C)", x = "Year") +
geom_text(aes(x = 2000 , y = 25.5, label = "Historic Trend")) +
geom_text(aes(x = 2025 , y = 25.5, label = "Forecast Trend"))
AvgTMinYearFP = ggplot(df, aes(year, AvgTMin)) +
geom_smooth(method = 'lm', fullrange = TRUE) +
annotate('rect', xmin = -Inf, xmax = 2021, ymin = -Inf, ymax = Inf,
fill = 'gray92') +
geom_vline(xintercept = seq(1980, 2020, 5), color = 'white') +
geom_hline(yintercept = seq(23.5, 25.5, 0.5), color = 'white') +
geom_line() +
scale_x_continuous(limits = c(1980, 2030)) +
ylim(18, 23) +
labs(y = "Avg. Min. T (C)", x = "Year")
AvgTMaxYearFP = ggplot(df, aes(year, AvgTMax)) +
geom_smooth(method = 'lm', fullrange = TRUE) +
annotate('rect', xmin = -Inf, xmax = 2021, ymin = -Inf, ymax = Inf,
fill = 'gray92') +
geom_vline(xintercept = seq(1980, 2020, 5), color = 'white') +
geom_hline(yintercept = seq(23.5, 25.5, 0.5), color = 'white') +
geom_line() +
scale_x_continuous(limits = c(1980, 2030)) +
ylim(27, 30) +
labs(y = "Avg. Max. T (C)", x = "Year")
# Combine plots
p = subplot(AvgTMeanYearFP, AvgTMinYearFP, AvgTMaxYearFP, titleY = TRUE, shareX = TRUE, nrows = 3) %>%
layout(title ="Historic Average Temperature And Future Temperature Projection")
# Add a box around the forecast trend
p$x$layout$shapes = list(type = "rect",
fillcolor = "red",
opacity = 0.1,
x0 = 2021,
x1 = 2030,
xref = "x",
y0 = 0,
y1 = 1,
yref = "paper")
p
Current output:
You can add margin to the layout, so e.g.
p = subplot(AvgTMeanYearFP, AvgTMinYearFP, AvgTMaxYearFP, titleY = TRUE, shareX = TRUE, nrows = 3) %>%
layout(title ="Historic Average Temperature And Future Temperature Projection",margin = list(t = 50))
with the t standing for top.
Related
Here is the graph that I have as a basis:
color_two_groups_type_2 <- c("dark red", "black")
pd <- position_dodge(0.4)
hedonic_price_indices %>% ggplot(aes(x=year, y=index, group=factor(sample_sizes), color=factor(sample_sizes))) +
geom_line(linetype = "dashed", position = pd) +
geom_point(size = 0.5, position = pd) +
geom_errorbar(aes(ymin = index_lower_ci, ymax = index_upper_ci), width = 0.15, size = 0.25, colour="black", position = pd) +scale_y_continuous(breaks = c(0.5,1.0,1.5,2.0,2.5), limits = c(0.125, 2.85)) +
theme(legend.position="bottom", legend.margin=margin(0,0,0,0), legend.box.margin=margin(-20,0,0,0)) +
scale_color_manual(labels = c("Alternative", "Normal"), values = color_two_groups_type_2, guide = guide_legend(reverse = TRUE)) +
labs(title = "", x = "", y = "Index value (2000 = 1)", color = "") +
scale_x_discrete(breaks = c(1985,1990,1995,2000,2005,2010,2015,2020))
Now I would like to have two different line types.
desired_linetype <- c("dotted", "solid")
color_two_groups_type_2 <- c("dark red", "black")
pd <- position_dodge(0.4)
hedonic_price_indices %>% ggplot(aes(x=year, y=index, group=factor(sample_sizes), color=factor(sample_sizes))) +
#geom_line(linetype = "dashed", position = pd) +
geom_line(aes(linetype = sample_sizes), position = pd) +
scale_linetype_manual(values = desired_linetype) +
geom_point(size = 0.5, position = pd) +
geom_errorbar(aes(ymin = index_lower_ci, ymax = index_upper_ci), width = 0.15, size = 0.25, colour="black", position = pd) +
scale_y_continuous(breaks = c(0.5,1.0,1.5,2.0,2.5), limits = c(0.125, 2.85)) + theme(legend.position="bottom", legend.margin=margin(0,0,0,0), legend.box.margin=margin(-20,0,0,0)) +
scale_color_manual(labels = c("Alternative", "Normal"), values = color_two_groups_type_2, guide = guide_legend(reverse = TRUE)) +
labs(title = "", x = "", y = "Index value (2000 = 1)", color = "") +
scale_x_discrete(breaks = c(1985,1990,1995,2000,2005,2010,2015,2020))
Unfortunately, I have got two legends by now. By adding + guides(col = "none") (e.g. at the bottom), the left part of the legend gets removed:
And alternatively, by changing scale_linetype_manual(values = desired_linetype) to scale_linetype_manual(values = desired_linetype, guide="none"), the right part of the legend is gets removed:
However, I would like to have mixed version of these two legends. I.e. a legend that shows both the line type and the color. How could I obtain this result? (and I would prefer not to have a legend title ("sample sizes"), as in my initial graph).
I would be thankful for any suggestion!
Here is some code to reproduce the graphs:
hedonic_price_indices <- structure(list(estimate = c(-0.575412358998748, -0.52549627191954, -0.48635414326085, -0.732792998304216, -0.562889873546058, -0.913572700671539, -1.13936126077503, -1.08231133221031, -1.3515171997382, -0.94983790292841 ), lower_ci = c(-0.626714841953077, -0.584959417015897, -0.542829387483941, -0.790953736050918, -0.620938372048851, -1.02481824744291, -1.26017870739697, -1.17246349249945, -1.41331442736626, -1.01254016013769), upper_ci = c(-0.524109876044418, -0.466033126823183, -0.429878899037759, -0.674632260557514, -0.504841375043265, -0.802327153900171, -1.01854381415308, -0.992159171921177, -1.28971997211013, -0.887135645719133), year = c("1984", "1985", "1986", "1987", "1988", "1984", "1985", "1986", "1987", "1988"), estimate_exp = c(-0.437527119774759, -0.408738135115574, -0.38513598119696, -0.519435103003286, -0.430439275221177, -0.598911308640654, -0.679976631974547, -0.661188486027214, -0.741152760388594, -0.613196281876959), lower_ci_exp = c(-0.465655673667104, -0.442871528710716, -0.41889823785973, -0.546587846514592, -0.462560117662101, -0.641138316492387, -0.71639666004378, -0.69039670436256, -0.756664572496545, -0.636705020910341 ), upper_ci_exp = c(-0.407917843611993, -0.372513502931199, -0.349412123229172, -0.490656308062782, -0.3963986859341, -0.551715477774212, -0.63887958407625, -0.629224741409214, -0.724652122619944, -0.588166297456909), index = c(0.562472880225241, 0.591261864884426, 0.61486401880304, 0.480564896996714, 0.569560724778823, 0.401088691359346, 0.320023368025453, 0.338811513972786, 0.258847239611406, 0.386803718123041), index_lower_ci = c(0.534344326332896, 0.557128471289284, 0.58110176214027, 0.453412153485408, 0.537439882337899, 0.358861683507613, 0.28360333995622, 0.30960329563744, 0.243335427503455, 0.363294979089659), index_upper_ci = c(0.592082156388007, 0.627486497068801, 0.650587876770828, 0.509343691937218, 0.6036013140659, 0.448284522225788, 0.36112041592375, 0.370775258590786, 0.275347877380056, 0.411833702543091), sample_sizes = c("Normal", "Normal", "Normal", "Normal", "Normal", "Alternative", "Alternative", "Alternative", "Alternative", "Alternative")), row.names = c("normal_sale_1984", "normal_sale_1985", "normal_sale_1986", "normal_sale_1987", "normal_sale_1988", "foreclosure_1984", "foreclosure_1985", "foreclosure_1986", "foreclosure_1987", "foreclosure_1988"), class = "data.frame")
To merge your legends use the same labels and guide in both scale_color and scale_linetype and the same name in labs:
library(ggplot2)
library(dplyr)
desired_linetype <- c("dotted", "solid")
color_two_groups_type_2 <- c("dark red", "black")
pd <- position_dodge(0.4)
hedonic_price_indices %>%
ggplot(aes(x = year, y = index, group = factor(sample_sizes), color = factor(sample_sizes))) +
geom_line(aes(linetype = sample_sizes), position = pd) +
geom_point(size = 0.5, position = pd) +
geom_errorbar(aes(ymin = index_lower_ci, ymax = index_upper_ci),
width = 0.15, size = 0.25, colour = "black", position = pd
) +
scale_x_discrete(breaks = c(1985, 1990, 1995, 2000, 2005, 2010, 2015, 2020)) +
scale_y_continuous(breaks = c(0.5, 1.0, 1.5, 2.0, 2.5), limits = c(0.125, 2.85)) +
scale_color_manual(
labels = c("Alternative", "Normal"),
values = color_two_groups_type_2,
guide = guide_legend(reverse = TRUE)
) +
scale_linetype_manual(
labels = c("Alternative", "Normal"),
values = desired_linetype,
guide = guide_legend(reverse = TRUE)
) +
labs(
title = "", x = "", y = "Index value (2000 = 1)",
color = "", linetype = ""
) +
theme(
legend.position = "bottom",
legend.margin = margin(0, 0, 0, 0),
legend.box.margin = margin(-20, 0, 0, 0)
)
I have 3 forecast plots that are combined together by plotly::subplot. The next step is draw a transparent box (or 3 separate boxes) with red dashed lines around the forecast line of each plot so that they stand out to the reader.
How can I do this ?
Desired Output:
Data (df):
structure(list(year = 1980:2021, AvgTMean = c(24.2700686838937,
23.8852956598276, 25.094446596092, 24.1561175050287, 24.157183605977,
24.3047482638362, 24.7899738481466, 24.5756232655603, 24.5833086228592,
24.7344695534483, 25.3094451071121, 25.2100615173707, 24.3651692293534,
24.5423890611494, 25.2492166633908, 24.7005097837931, 24.2491591827443,
25.0912281781322, 25.0779264303305, 24.403294248319, 24.4983991453592,
24.4292324356466, 24.8179824927011, 24.7243948463075, 24.5086534543966,
24.2818632071983, 24.4567195220259, 24.8402224356034, 24.6574465515086,
24.5440715673563, 23.482670620977, 24.9979594684914, 24.5452453980747,
24.9271462811494, 24.7443215819253, 25.8929839790805, 25.1801908261063,
25.2079308058908, 25.0722425561207, 25.4554644289799, 25.4548979078736,
25.0756772250287), AvgTMin = c(19.6018663372126, 18.9935718486724,
20.8351710187356, 19.7723002680316, 19.8097384811782, 19.7280847671034,
20.2907499842098, 20.1950373662931, 20.1812715311494, 20.1808865070833,
21.0320272801006, 21.1252427976293, 20.1712830368678, 20.407655174727,
21.5430646243391, 20.6760574525862, 20.0822658237356, 21.0735574619397,
21.0871494406322, 20.1311178414224, 20.3191250001149, 20.3474683732557,
20.668169553204, 20.3772270269296, 20.2330157893678, 19.9486551337931,
20.1114496908333, 20.5816350393966, 20.4033879191236, 20.1582514856897,
19.2288879223678, 20.8451063140805, 20.4878865041092, 21.0259712576437,
20.5510100674138, 22.0143793370977, 21.3529094881753, 21.1688506012213,
21.040550304569, 21.4923981385632, 21.6580430460057, 21.2433069288506
), AvgTMax = c(28.9392198638937, 28.778245693046, 29.3549223685201,
28.5411393752011, 28.5058118063649, 28.8825532046983, 29.2903534709195,
28.9574051835776, 28.9865201368247, 29.2891997662069, 29.5881379007328,
29.2960976760201, 28.5602557685057, 28.6782844806753, 28.9566034394684,
28.7262054694971, 28.4171896994397, 29.1100747038649, 29.0698836095546,
28.6766350461063, 28.6788764437787, 28.5122026355891, 28.9690143596839,
29.0727844759914, 28.7854971337931, 28.6163189712069, 28.8032270024138,
29.1000460207471, 28.9127356101149, 28.9310646744109, 27.7376810545833,
29.1520129070402, 28.6037845089512, 28.8295359311638, 28.9388276133764,
29.7726939654598, 29.0086407880029, 29.2482097613937, 29.1050890698132,
29.4187571974569, 29.2519238543247, 28.9081913630029)), class = "data.frame", row.names = c(NA,
-42L))
Code
library(tidyverse)
library(plotly)
AvgTMeanYearFP = ggplot(df, aes(year, AvgTMean)) +
geom_smooth(method = 'lm', fullrange = TRUE) +
annotate('rect', xmin = -Inf, xmax = 2021, ymin = -Inf, ymax = Inf,
fill = 'gray92') +
geom_vline(xintercept = seq(1980, 2020, 5), color = 'white') +
geom_hline(yintercept = seq(23.5, 25.5, 0.5), color = 'white') +
geom_line() +
scale_x_continuous(limits = c(1980, 2030)) +
labs(y = "Avg. Mean T (C)", x = "Year") +
geom_text(aes(x = 2000 , y = 25.5, label = "Historic Trend")) +
geom_text(aes(x = 2025 , y = 25.5, label = "Forecast Trend"))
AvgTMinYearFP = ggplot(df, aes(year, AvgTMin)) +
geom_smooth(method = 'lm', fullrange = TRUE) +
annotate('rect', xmin = -Inf, xmax = 2021, ymin = -Inf, ymax = Inf,
fill = 'gray92') +
geom_vline(xintercept = seq(1980, 2020, 5), color = 'white') +
geom_hline(yintercept = seq(23.5, 25.5, 0.5), color = 'white') +
geom_line() +
scale_x_continuous(limits = c(1980, 2030)) +
ylim(18, 23) +
labs(y = "Avg. Min. T (C)", x = "Year")
AvgTMaxYearFP = ggplot(df, aes(year, AvgTMax)) +
geom_smooth(method = 'lm', fullrange = TRUE) +
annotate('rect', xmin = -Inf, xmax = 2021, ymin = -Inf, ymax = Inf,
fill = 'gray92') +
geom_vline(xintercept = seq(1980, 2020, 5), color = 'white') +
geom_hline(yintercept = seq(23.5, 25.5, 0.5), color = 'white') +
geom_line() +
scale_x_continuous(limits = c(1980, 2030)) +
ylim(27, 30) +
labs(y = "Avg. Max. T (C)", x = "Year")
# Combine plots
subplot(AvgTMeanYearFP, AvgTMinYearFP, AvgTMaxYearFP, titleY = TRUE, shareX = TRUE, nrows = 3) %>%
layout(title ="Historic Average Temperature And Future Temperature Projection")
I actually like one box over all plots more aesthetically. Had a hard time doing this, because there seems to be a known issue with using ggplotly and the layout() function. That's why the shapes are put in p$x$layout$shapes like this.
# Combine plots
p <- subplot(AvgTMeanYearFP, AvgTMinYearFP, AvgTMaxYearFP, titleY = TRUE, shareX = TRUE, nrows = 3) %>%
layout(title ="Historic Average Temperature And Future Temperature Projection")
p$x$layout$shapes <- list(type = "rect",
line = list(color = "red",
dash = 'dash'),
x0 = 2021,
x1 = 2030,
xref = "x",
y0 = 0,
y1 = 1,
yref = "paper")
p
An alternative to a dashed box could be using the opacity.
list(type = "rect",
fillcolor = "red",
opacity = 0.1,
x0 = 2021,
x1 = 2030,
xref = "x",
y0 = 0,
y1 = 1,
yref = "paper")
I can also get you some of the way there - by making a red box in each figure, but putting a single box across the whole plot is going to be more challenging.
library(tidyverse)
library(plotly)
add_box <- function(p, start=2022, stop=NULL, prop_in=.05, ...){
pb <- ggplot_build(p)
rgy <- pb$layout$panel_params[[1]]$y.range
rgx <- pb$layout$panel_params[[1]]$x.range
px1 <- diff(rgx)*prop_in
py1 <- diff(rgy)*prop_in
rgx <- c(1,-1)*px1 + rgx
rgy <- c(1,-1)*py1 + rgy
rgx[1] <- start
if(!is.null(stop)){
rgx[2] <- stop
}
boxdf <- data.frame(x = rgx[c(1,2,2,1,1)],
y=rgy[c(1,1,2,2,1)])
p + geom_path(data=boxdf,
aes(x=x,
y=y),
col="red",
linetype=2)
}
AvgTMeanYearFP = ggplot(df, aes(year, AvgTMean)) +
geom_smooth(method = 'lm', fullrange = TRUE) +
annotate('rect', xmin = -Inf, xmax = 2021, ymin = -Inf, ymax = Inf,
fill = 'gray92') +
geom_vline(xintercept = seq(1980, 2020, 5), color = 'white') +
geom_hline(yintercept = seq(23.5, 25.5, 0.5), color = 'white') +
geom_line() +
scale_x_continuous(limits = c(1980, 2030)) +
labs(y = "Avg. Mean T (C)", x = "Year") +
geom_text(aes(x = 2000 , y = 25.5, label = "Historic Trend")) +
geom_text(aes(x = 2025 , y = 25.5, label = "Forecast Trend"))
AvgTMinYearFP = ggplot(df, aes(year, AvgTMin)) +
geom_smooth(method = 'lm', fullrange = TRUE) +
annotate('rect', xmin = -Inf, xmax = 2021, ymin = -Inf, ymax = Inf,
fill = 'gray92') +
geom_vline(xintercept = seq(1980, 2020, 5), color = 'white') +
geom_hline(yintercept = seq(23.5, 25.5, 0.5), color = 'white') +
geom_line() +
scale_x_continuous(limits = c(1980, 2030)) +
ylim(18, 23) +
labs(y = "Avg. Min. T (C)", x = "Year")
AvgTMaxYearFP = ggplot(df, aes(year, AvgTMax)) +
geom_smooth(method = 'lm', fullrange = TRUE) +
annotate('rect', xmin = -Inf, xmax = 2021, ymin = -Inf, ymax = Inf,
fill = 'gray92') +
geom_vline(xintercept = seq(1980, 2020, 5), color = 'white') +
geom_hline(yintercept = seq(23.5, 25.5, 0.5), color = 'white') +
geom_line() +
scale_x_continuous(limits = c(1980, 2030)) +
ylim(27, 30) +
labs(y = "Avg. Max. T (C)", x = "Year")
# Combine plots
subplot(AvgTMeanYearFP %>% add_box(stop=2030, prop_in=.05),
AvgTMinYearFP %>% add_box(stop=2030, prop_in=.05),
AvgTMaxYearFP %>% add_box(stop=2030, prop_in=.05),
titleY = TRUE, shareX = TRUE, nrows = 3) %>%
layout(title ="Historic Average Temperature And Future Temperature Projection")
The add_box() function does a few different things. First, it builds your plot so I can grab the ranges of the x and y axes. If you try to plot the box all the way to the end of the range, the top, bottom and right side lines don't print. So, I have it pull the those edges prop_in toward the interior of the plot. I found that .05 is about the smallest that worked. Then, I change the rgx and rgy objects accordingly. Then, I replace the first and optionally second value of rgx with the start and stop arguments from the function call. I take the range values and make them into a data frame that will be amenable to plot with geom_path() and then I add the appropriate geom_path() function to your existing plot.
I have dataframe which represents sales by model within 2 different years. 'change' column stands for absolute change by models from 2020 to 2021 while 'chng.percent' measures this change in percentages.
However, I am struggling to apply the given Code of slope plot to my data.
df <- data.frame (model = c("A", "A", "B","B"),
year = c(2020,2021,2020,2021),
sale =c(105,190,110,180),
chang = c(85,NA,70,NA),
chng.percent = c(80.9,NA, 63.6,NA))
Expected outcome (Like this)
Here's a way to do it all within ggplot using your existing data:
ggplot(df, aes(year, sale, color = model)) +
geom_line(arrow = arrow(type = "closed", angle = 20),
key_glyph = draw_key_point) +
geom_vline(aes(xintercept = year)) +
geom_text(aes(label = sale, hjust = ifelse(year == 2020, 1.3, -0.3)),
color = "black",
size = 6) +
geom_text(aes(x = min(df$year) + 0.25, y = 105,
label = paste0("+", chang[1], "; ", chng.percent[1], "%"),
color = "A"), size = 5) +
geom_text(aes(x = max(df$year) - 0.25, y = 150,
label = paste0("+", chang[3], "; ", chng.percent[3], "%"),
color = "B"), size = 5) +
theme_void(base_size = 16) +
coord_cartesian(clip = "off") +
scale_x_continuous(breaks = c(2020, 2021)) +
guides(color = guide_legend(override.aes = list(size = 5))) +
scale_color_brewer(palette = "Set1") +
theme(plot.margin = margin(30, 30, 30, 30),
aspect.ratio = 1.5,
axis.text.x = element_text(size = 20))
you can try something like this :
df <- data.frame(model = c("A", "B"),
sale_2020 =c(105,110),
sale_2021 =c(190,180),
chang = c(85,70),
chng.percent = c(80.9, 63.6))
df %>%
ggplot() +
geom_segment(aes(x = 1, xend = 2,
y = sale_2020,
yend = sale_2021,
group = model,
col = model),
size = 1.2) +
# set the colors
scale_color_manual(values = c("#468189", "#9DBEBB"), guide = "none") +
# remove all axis stuff
theme_classic() +
theme(axis.line = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
axis.ticks = element_blank()) +
geom_text(aes(x = x, y = y, label = label),
data = data.frame(x = 1:2,
y = 10 + max(df$sale_2021),
label = c("2020", "2021")),
col = "grey30",
size = 6) +
# add vertical lines that act as axis for 2020
geom_segment(x = 1, xend = 1,
y = min(df$sale_2020) -10,
yend = max(df$sale_2020) + 81,
col = "grey70", size = 1.5) +
# add vertical lines that act as axis for 2021
geom_segment(x = 2, xend = 2,
y = min(df$sale_2021) - 80,
yend = max(df$sale_2021) + 1,
col = "grey70", size = 1.5) +
# add the success rate next to each point on 2021 axis
geom_text(aes(x = 2 + 0.08,
y = sale_2021,
label = paste0(round(sale_2021, 1))),
col = "grey30") +
# add the success rate next to each point on 2021 axis
geom_text(aes(x = 1 - 0.08,
y = sale_2020,
label = paste0(round(sale_2020, 1))),
col = "grey30") +
# add the success rate next to each point on 2020 axis
geom_text(aes(x = 2 - 0.5,
y = c(156, 135),
label = paste0(round(chng.percent, 1), "%")),
col = "grey30")
When using geom_ribbon() with the shape aesthetic, there appears to be a difference in the opacity on the shaded area creating blocks in the region.
I have recreated the problem where I identified that these opacity changes are only present when the shape aesthetic is included.
Data set up:
alpha <- c("A","B","C","D", "E", "F", "G")
percent <- c(0.012, -0.02, 0.015, -0.01, 0.89, 0.12, -0.25)
flow <- c(-5, 2, -3, 3, 1, 4, -2)
shape <- c("D", "D", "L", "L", "L", "D", "L")
df <- data.frame(alpha,percent,flow, shape)
x_min = min(df$percent)
x_min = round(x_min/0.01)*0.01 - 0.01
x_max = max(df$percent)
x_max = round(x_max/0.01)*0.01 + 0.01
y_min = min(df$flow)
y_min = round(y_min)
y_max = max(df$flow)
y_max = round(y_max)
n_row = nrow(df)
Chart with no shape aesthetic, geom_ribbon() works:
df %>%
ggplot(aes(x = percent, y = flow, label = alpha)) +
geom_point() +
geom_text_repel(show.legend = FALSE, size = 3) +
scale_size_continuous(labels = scales::percent) +
theme_bw() +
scale_x_continuous(labels = scales::percent_format(accuracy = 0.1L)) +
scale_y_continuous(labels = scales::dollar_format(negative_parens = TRUE, suffix = "m")) +
geom_ribbon(aes(x = seq(x_min, x_max + 0.01, length.out = n_row), ymin = 0, ymax = y_max), alpha = 0.04, linetype = 0, show.legend = FALSE, fill = "green") +
geom_ribbon(aes(x = seq(x_min, x_max + 0.01, length.out = n_row), ymin = y_min, ymax = 0), alpha = 0.04, linetype = 0, show.legend = FALSE, fill = "red")
Chart with shape aesthetic, geom_ribbon() seems not to work:
df %>%
ggplot(aes(x = percent, y = flow, label = alpha, shape = shape)) +
geom_point() +
geom_text_repel(show.legend = FALSE, size = 3) +
scale_size_continuous(labels = scales::percent) +
theme_bw() +
scale_x_continuous(labels = scales::percent_format(accuracy = 0.1L)) +
scale_y_continuous(labels = scales::dollar_format(negative_parens = TRUE, suffix = "m")) +
geom_ribbon(aes(x = seq(x_min, x_max + 0.01, length.out = n_row), ymin = 0, ymax = y_max), alpha = 0.04, linetype = 0, show.legend = FALSE, fill = "green") +
geom_ribbon(aes(x = seq(x_min, x_max + 0.01, length.out = n_row), ymin = y_min, ymax = 0), alpha = 0.04, linetype = 0, show.legend = FALSE, fill = "red")
The issue is some kind of overplotting and the way you add the background fills via geom_ribbon. Basically, by adding shape as a global aesthetic your data gets grouped and your ribbons are drawn multiple times, once for each group. To solve this issue make shape a local aes by moving it inside geom_point:
library(ggplot2)
ggplot(df, aes(x = percent, y = flow, label = alpha)) +
geom_point(aes(shape = shape)) +
ggrepel::geom_text_repel(show.legend = FALSE, size = 3) +
scale_size_continuous(labels = scales::percent) +
theme_bw() +
scale_x_continuous(labels = scales::percent_format(accuracy = 0.1L)) +
scale_y_continuous(labels = scales::dollar_format(negative_parens = TRUE, suffix = "m")) +
geom_ribbon(aes(x = seq(x_min, x_max + 0.01, length.out = n_row), ymin = 0, ymax = y_max), alpha = 0.04, linetype = 0, show.legend = FALSE, fill = "green") +
geom_ribbon(aes(x = seq(x_min, x_max + 0.01, length.out = n_row), ymin = y_min, ymax = 0), alpha = 0.04, linetype = 0, show.legend = FALSE, fill = "red")
However, instead of making use of geom_ribbon in my opinion you could get your result much easier and less error prone by adding your background rectangles via annotate, which depending on your desired result does not even require to compute the min and max values. Instead you could simply use -Inf and Inf:
ggplot(df, aes(x = percent, y = flow, label = alpha, shape = shape)) +
geom_point() +
ggrepel::geom_text_repel(show.legend = FALSE, size = 3) +
scale_size_continuous(labels = scales::percent) +
theme_bw() +
scale_x_continuous(labels = scales::percent_format(accuracy = 0.1)) +
scale_y_continuous(labels = scales::dollar_format(negative_parens = TRUE, suffix = "m")) +
annotate(geom = "rect", xmin = -Inf, xmax = Inf, ymin = 0, ymax = Inf, alpha = 0.04, fill = "green") +
annotate(geom = "rect", xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = 0, alpha = 0.04, fill = "red")
I am trying to plot some data in a ggplotly plot.
The x-axis contains dates. Ggplotly doesn't work well with dates as when I hover over a point, the date is displayed as a number.
I solved this by setting a tooltip like below.
Some sample data:
x <- data.frame(Date = as.Date(seq(Sys.Date(), Sys.Date() + 29, by = "days")), Amount = seq(-10000, 19000, by = 1000),
stringsAsFactors = FALSE)
The plot:
ggplotly(ggplot(x, aes(x = Date, y = Amount, group = 1, text = paste("Date: ", Date, "<br>Amount: ", Amount))) + geom_line() + geom_point()
, tooltip = "text")
Now I want to use geom_rect() to get some background colors depending on the value of the y-axis. This gives me problems as the rectangles seem to be placed on top of the geom_line(). Also, the rectangles are labeled by ggplotly too, which I don't want either.
Here is the code I tried (the background coloring works fine when I am not using a custom tooltip, but then the problem with the dates in the labels occurs):
ggplotly(ggplot(x, aes(x = Date, y = Amount, group = 1, text = paste("Date: ", Date, "<br>Amount: ", Amount))) + geom_line() + geom_point()
+
geom_rect(aes(xmin = as.Date(Sys.Date()),
xmax = as.Date(Sys.Date() + 30),
ymin = 10000, ymax = max(max(x$Amount) + 1000, 11000), fill = "1")) +
geom_rect(aes(xmin = as.Date(Sys.Date()),
xmax = as.Date(Sys.Date() + 30),
ymin = 0, ymax = 10000, fill = "2")) +
geom_rect(aes(xmin = as.Date(Sys.Date()),
xmax = as.Date(Sys.Date() + 30),
ymin = min(min(x$Amount) - 1000, 0), ymax = 0, fill = "3"))
+
scale_fill_manual(values = alpha(c("green", "orange", "red"), 0.2))
, tooltip = "text")
Result
Any help would be appreciated, thanks!
EDIT:
The following code results in working geom_rect():
ggplotly(ggplot(x, aes(x = Date, y = Amount)) + geom_line() + geom_point()
+
geom_rect(aes(xmin = as.Date(Sys.Date()),
xmax = as.Date(Sys.Date() + 30),
ymin = 10000, ymax = max(max(x$Amount) + 1000, 11000), fill = "1")) +
geom_rect(aes(xmin = as.Date(Sys.Date()),
xmax = as.Date(Sys.Date() + 30),
ymin = 0, ymax = 10000, fill = "2")) +
geom_rect(aes(xmin = as.Date(Sys.Date()),
xmax = as.Date(Sys.Date() + 30),
ymin = min(min(x$Amount) - 1000, 0), ymax = 0, fill = "3"))
+
scale_fill_manual(values = alpha(c("green", "orange", "red"), 0.2)))
Result
You could try this:
ggplotly(ggplot() +
geom_rect(data = x, aes(xmin = as.Date(Sys.Date()),
xmax = as.Date(Sys.Date() + 30),
ymin = 10000, ymax = max(max(x$Amount) + 1000, 11000), fill = "1")) +
geom_rect(data = x, aes(xmin = as.Date(Sys.Date()),
xmax = as.Date(Sys.Date() + 30),
ymin = 0, ymax = 10000, fill = "2")) +
geom_rect(data = x, aes(xmin = as.Date(Sys.Date()),
xmax = as.Date(Sys.Date() + 30),
ymin = min(min(x$Amount) - 1000, 0), ymax = 0, fill = "3")) +
geom_line(data = x, aes(x = Date, y = Amount, group = 1, text = paste("Date: ", Date, "<br>Amount: ", Amount))) +
geom_point(data = x, aes(x = Date, y = Amount, text = paste("Date: ", Date, "<br>Amount: ", Amount))) +
scale_fill_manual(values = alpha(c("green", "orange", "red"), 0.2))
, tooltip = "text")