I am trying to add the below "graphic" to a chart I am doing in R.
I could easily do the graphic in a graphics application and then 'glue' it together with the R graph. However, it could be cool to make everything in R since it has the caveat that the position of the black arrow depends on calculated number. In the below case 6.8.
Any suggestions on how I could trick R to produce something like this?
This is a start for a function in base graphics:
draw <- function(x){
plot(NA, xlim=c(0,7), ylim=c(-.3,1), xaxt="n", yaxt="n", xlab="", ylab="")
lines(x=c(0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,0),
y=rep(c(0,1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0)))
lines(c(0,7),c(1,1))
for(i in 1:7) text(x = i-0.5, y= 0.5, labels=i)
arrows(0, 1.5, 7, 1.5, code=3)
polygon(x -1 +c(-.1, 0, .1),c(-.3,-0.05,-.3), col="black")
}
draw(4)
draw(3)
If you are interested in a base graphics function, you will probably want to make the width:heigth ratio fixed an change my polygon-triangle into a proper arrow, add some more text and things, but this should get you started:
Here's the ggplot2 solution:
df_nums <- data.frame(number <- 1:7,
fill <- c(rep("white", 5), "darkblue", "white"),
color <- c(rep("black", 5), "white", "black"))
df_text <- data.frame(label = c("Lower Risk", "Higher Risk", "Typically Lower Rewards",
"Typically Higher Rewards"),
hjust = c(0, 1, 0, 1),
x = c(0, 7, 0, 7),
y = c(2.9, 2.9, 2.1, 2.1))
arrow_x_pos <- 6.8 # position of arrow
p1 <- ggplot(df_nums) +
geom_tile(aes(x = number - .5, y = 1, fill = fill), size = 1, color = "black") +
geom_text(aes(x = number - .5, y = 1, color = color, label = number), size = 8) +
scale_color_identity(guide = "none") + scale_fill_identity(guide = "none") +
geom_text(data = df_text, aes(x = x, y = y, label = label, hjust = hjust), size = 5.5,
fontface = "bold") +
geom_text(aes(label = "Risk and Reward Profile", x = 0, y = 3.5),
fontface = "bold", size = 6.5, hjust = 0) +
geom_segment(x = 0, xend = 7, y = 2.5, yend = 2.5, size = 1,
arrow = arrow(length = unit(10,"pt"), ends = "both"),
color = "grey70") +
geom_segment(x = arrow_x_pos - 1, xend = arrow_x_pos - 1, y = -.3, yend = .2, size = 4,
arrow = arrow(length = unit(7, "pt"), type = "closed"),
lineend = "butt", linejoin = "mitre") +
ylim(-.2, 3.6) +
coord_fixed() +
theme_void()
p1
Related
This is an awkward question, and I don't want to offend anyone. I'd like to recreate the following figure in R. The plot is based on a published work. I'm not sure what the backstory is. How should I proceed using ggplot?
We can get arbitrarily close in ggplot as long as we are prepared to put the work into preparing the data.
Firstly, we need a data frame of the labels and the segment positions:
df <- data.frame(text = c('Africa', 'Asia', 'Countries in transition',
'North America', 'South America',
'Western Europe'),
y = 6:1,
x = c(0, 0, 1.5, 6.5, 0, 6),
xend = c(5, 6.5, 6, 10, 5, 10))
Secondly, we need the x axis labels:
xlabs <- c('early EIAs,\noften donor\nfunded',
'EIA regulation/guidance\nenacted, increasing EIAs\nquality variable',
'EIA mainstream,\nfine-tuning of\nregulation/guidance')
If you want the polka-dot background, it is possible to do this via ggpattern, but if you want to stick to CRAN-based repositories, we can now use a pattern fill in grid, which you already have installed. You will need to have the latest version of R installed to do this though:
library(grid)
small_circ1 <- circleGrob(
r = unit(0.5, 'mm'),
gp = gpar(fill = '#d4dbed', col = '#d4dbed')
)
small_circ2 <- circleGrob(
r = unit(0.5, 'mm'),
gp = gpar(fill = '#c5d0e5', col = '#c5d0e5')
)
small_circle_pattern1 <- pattern(
small_circ1,
width = unit(2.5, 'mm'),
height = unit(2.5, 'mm'),
extend = 'repeat'
)
small_circle_pattern2 <- pattern(
small_circ2,
width = unit(2.5, 'mm'),
height = unit(2.5, 'mm'),
extend = 'repeat'
)
Now we are ready to plot. The easiest way to get the broken line segments with text is using geom_textsegment from geomtextpath
library(geomtextpath)
ggplot(df, aes(x, y)) +
annotation_custom(rectGrob(gp = gpar(fill = small_circle_pattern1,
col = NA)),
ymin = -Inf, ymax = Inf, xmin = 2, xmax = 6) +
annotation_custom(rectGrob(gp = gpar(fill = '#e6e9f9', col = '#e6e9f9')),
ymin = -Inf, ymax = Inf, xmin = 6, xmax = 10) +
annotation_custom(rectGrob(gp = gpar(fill = small_circle_pattern2,
col = NA)),
ymin = -Inf, ymax = Inf, xmin = 6, xmax = 10) +
geom_textsegment(aes(yend = y, xend = xend, label = text, fontface = 2),
colour = '#556fa1', linewidth = 0.7, size = 5) +
scale_x_continuous(breaks = c(0, 2, 6),
labels = xlabs, expand = c(0, 0)) +
theme_classic() +
theme(axis.text.x = element_text(size = 14, hjust = 0,
margin = margin(20, 0, 0, 0),
colour = '#556fa1'),
axis.line = element_line(colour = '#556fa1'),
axis.ticks = element_blank(),
axis.text.y = element_blank(),
axis.title = element_blank())
It remains unclear, how detailed the reproduction ought to be (same background or same in general=). It is also unclear, which graphics system you want to work in. Should you want to try that in base graphics, the following might provide you with a workable starting point:
dat <- data.frame(continent = c("Afrika", "Asia", "North America",
"South America", "Europe"),
from = c(0, 0, 6, 0, 5),
to = c(4, 5.5, 10, 5, 10))
dat$mean <- (dat$from + dat$to) / 2
plot(NA, xlim = c(0, 10), ylim = c(0,6), xaxt = "n", yaxt = "n",
xlab = "", ylab = "")
for(i in 1:5){
print(c(dat$from[i], dat$to[i]))
lines(x = c(dat$from[i], dat$to[i]),
y = c(6-i, 6-i),
col = "lightblue", lwd = 2)
}
text(dat$mean, y = (5:1)+.3, labels = dat$continent,
col = "lightblue")
As a mere starting point on how to possibly approach the problem in ggplot2:
dat <- data.frame(no = 1:5,
continent = c("Afrika", "Asia", "North America",
"South America", "Europe"),
from = c(0, 0, 6, 0, 5),
to = c(4, 5.5, 10, 5, 10))
library(ggplot2)
ggplot(dat) +
geom_segment(aes(x = from, y = 6-no, xend = to, yend = 6-no), lwd = 2) +
geom_text(aes(x = mean, y = 6.2-no, label = continent)) +
theme_bw()
I'm trying to make a ggplot2 plot with the colors of points and segments mapped to a continuous variable (time, in this case). The points show up with colors I'd expect based on the gradient and the time mapped to that color, but the segment for the first point, when time = 0, does not. Here's an example:
Oxy <- data.frame(Time = c(0, 0.5, 1, 1.5, 2, 4, 8, 12),
DrugConc = c(0, 8, 12, 13, 10, 7.5, 5, 2.5),
Pupil = c(0, -0.04, -0.1, -0.25, -0.23, -0.2, -0.15, -0.08))
for(j in 1:(nrow(Oxy)-1)){
Oxy$Xstart[j] <- Oxy$Pupil[j]
Oxy$Xend[j] <- Oxy$Pupil[j+1]
Oxy$Ystart[j] <- Oxy$DrugConc[j]
Oxy$Yend[j] <- Oxy$DrugConc[j+1]
}
ggplot(Oxy, aes(x = Pupil, y = DrugConc, color = Time)) +
geom_point() +
geom_segment(data = Oxy,
aes(x = Xstart, xend = Xend, y = Ystart, yend = Yend),
arrow = arrow(length = unit(8, "points"), type = "open")) +
xlab("Percent change in pupil diameter") +
ylab("Oxycodone concentration (ng/mL)")
This results in this graph:
The first segment should be dark blue, not light blue, just like the first point. Am I missing something?
The 8th row of Oxy basically overplots the first row. I visualized this by changing Time to a factor and also adding size as an aesthetic so we can easily see what ggplot() is doing.
library(ggplot2)
Oxy <- data.frame(Time = c(0, 0.5, 1, 1.5, 2, 4, 8, 12),
DrugConc = c(0, 8, 12, 13, 10, 7.5, 5, 2.5),
Pupil = c(0, -0.04, -0.1, -0.25, -0.23, -0.2, -0.15, -0.08))
for(j in 1:(nrow(Oxy)-1)){
Oxy$Xstart[j] <- Oxy$Pupil[j]
Oxy$Xend[j] <- Oxy$Pupil[j+1]
Oxy$Ystart[j] <- Oxy$DrugConc[j]
Oxy$Yend[j] <- Oxy$DrugConc[j+1]
}
#Plot just the first four row segments
ggplot(Oxy[1:4,], aes(x = Pupil, y = DrugConc, colour = factor(Time), size = factor(Time))) +
geom_point() +
geom_segment(aes(x = Xstart, xend = Xend, y = Ystart, yend = Yend),
arrow = arrow(length = unit(8, "points"), type = "open")) +
scale_colour_brewer(type = "div")
#> Warning: Using size for a discrete variable is not advised.
#plot rows 5 - 8
ggplot(Oxy[5:8,], aes(x = Pupil, y = DrugConc, colour = factor(Time), size = factor(Time))) +
geom_point() +
geom_segment(aes(x = Xstart, xend = Xend, y = Ystart, yend = Yend),
arrow = arrow(length = unit(8, "points"), type = "open")) +
scale_colour_brewer(type = "div")
#> Warning: Using size for a discrete variable is not advised.
Created on 2019-01-15 by the reprex package (v0.2.1)
In short - there's likely a bug in your input data, ggplot() is doing what it's supposed to do.
Reproducible data:
df <- data.frame(cbind("Thriving" = c(2, 2, NA, runif(9, 2.0, 5.0)), "Performance" = c(2, 3.5, 2.3, 4.2, NA, runif(7, 1.9, 6.9)), "Mastery_Climate" = c(runif(10, 2.2, 6.5), NA, 2.3), "Competitive_Climate" = c(NA, runif(4, 1.0, 3.6), NA, NA, runif(5, 1.5, 2.8)), "Collaboration" = c(runif(8, 2.2, 7.0), NA, NA, 5.5, 2.1)))
With this data I want to create bloxplots using the following command with the packages ggplot2 and tidyr:
df %>%
gather(key = "variable", value = "value") -> n
n$variable <- factor(n$variable, levels = c("Thriving", "Performance", "Mastery_Climate", "Competitive_Climate", "Collaboration"))
ggplot(data = n, aes(y = value, x = variable)) + stat_summary(fun.data = min.mean.sd.max, geom = "boxplot", col = "#323232", fill = "#EFC76C") +
coord_flip() + scale_y_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7)) +
expand_limits(y = c(1, 7)) +
labs(x = "", y = "") +
theme(text = element_text(size = 12), panel.background = element_rect(fill = "#EAEDED")) +
theme(plot.margin=unit(c(0, 2, 0, 1.8),"cm"))
The function used in stat_summary is as follows:
min.mean.sd.max <- function(x) {
r <- c(min(x), mean(x) - sd(x), mean(x), mean(x) + sd(x), max(x))
names(r) <- c("ymin", "lower", "middle", "upper", "ymax")
r
}
Now, HERE IT COMES: everything works beautifully, however, now I would like to colour the background in three different colours, green, yellow and red. I know that I have to use geom_rect for that. However, in order to have the boxplots in the foreground, I need to pass the geom_rect argument first - but this breaks my code:
df %>%
gather(key = "variable", value = "value") -> n
n$variable <- factor(n$variable, levels = c("Thriving", "Performance", "Mastery_Climate", "Competitive_Climate", "Collaboration"))
ggplot(data = n, aes(y = value, x = variable)) +
geom_rect(aes(xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = 3, fill = "green"), alpha = .01) +
geom_rect(aes(xmin = -Inf, xmax = Inf, ymin = 3, ymax = 5, fill = "yellow"), alpha = .01) +
geom_rect(aes(xmin = -Inf, xmax = Inf, ymin = 5, ymax = Inf, fill = "red"), alpha = .01) +
stat_summary(fun.data = min.mean.sd.max, geom = "boxplot", col = "#323232", fill = "#EFC76C") +
coord_flip() + scale_y_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7)) +
expand_limits(y = c(1, 7)) +
labs(x = "", y = "") +
theme(text = element_text(size = 12), panel.background = element_rect(fill = "#EAEDED")) +
theme(plot.margin=unit(c(0, 2, 0, 1.8),"cm"))
As you can see, I get the error "Error: Discrete value supplied to continuous scale". From research I understand that this is because I needed to change the sequence and it now is a problem that the x-variable is a factor. However, I have been unable to solve this.
It would be great if all the other code could stay the same, it took me ages to put it together. Also, once the boxplots are in the foreground, it would be great if the grid behind would still be visible. Furthermore, I was so confused by the fill in geom_rect, I put in "green" and I get pink, or I put "yellow" and get blue - no clue why.
In any case, any help is very much appreciated. Many greetings!
Edit: Updated answer with better shading control
I think this approach is more idiomatic to ggplot: this puts the shading into a separate table with numeric y values. In a modified ggplot call, all the y values are mapped as numeric values, but the labels for those values are swapped out in the scale_y_continuous line.
rects <- data.frame(xmin = -Inf,
xmax = Inf,
ymin = c(0,3,5),
ymax = c(3,5,Inf),
fill = c("green", "yellow", "red"))
ggplot(data = n, aes(y = value, x = as.numeric(variable))) +
geom_rect(data = rects, aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, fill = fill),
# Control the shading opacity here.
inherit.aes = FALSE, alpha = 0.15) +
stat_summary(fun.data = min.mean.sd.max, geom = "boxplot", col = "#323232", fill = "#EFC76C") +
scale_fill_identity() +
scale_x_continuous(breaks = as.numeric(unique(n$variable)), minor_breaks = NULL,
labels = unique(n$variable)) +
scale_y_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7)) +
expand_limits(y = c(1, 7)) +
coord_flip() +
labs(x = "", y = "") +
theme(text = element_text(size = 12), panel.background = element_rect(fill = "#EAEDED")) +
theme(plot.margin=unit(c(0, 2, 0, 1.8),"cm"))
Original answer
geom_rect's coordinates should be pulled outside of the aes() call, and then I get a working solution. However, one problem with this approach is that the background rectangles are actually getting drawn once for each element in the source data, which is why the colors are so bright even with alpha = 0.01.
ggplot(data = n, aes(y = value, x = variable)) +
geom_rect(xmin = -Inf, xmax = Inf, ymin = 0, ymax = 3, fill = "green", alpha = .005) +
geom_rect(xmin = -Inf, xmax = Inf, ymin = 3, ymax = 5, fill = "yellow", alpha = .005) +
geom_rect(xmin = -Inf, xmax = Inf, ymin = 5, ymax = 7, fill = "red", alpha = .005) +
stat_summary(fun.data = min.mean.sd.max, geom = "boxplot", col = "#323232", fill = "#EFC76C") +
coord_flip() + scale_y_continuous(breaks = c(1, 2, 3, 4, 5, 6, 7)) +
expand_limits(y = c(1, 7)) +
labs(x = "", y = "") +
theme(text = element_text(size = 12), panel.background = element_rect(fill = "#EAEDED")) +
theme(plot.margin=unit(c(0, 2, 0, 1.8),"cm"))
Is there a way to add a line just to a continuous gradient legend? I was unable to find any examples of this using ggplot2.
For example, how could I add a red horizontal line to only the legend at say, 1.7?
library(ggplot2)
x <- seq(1:1000)
y <-rnorm(1000,0,1)
df <- data.frame(x,y)
ggplot(df, aes(x, y, color = y)) + geom_point()
Like this:
It might not make a lot of sense as to why I'd like that. For more context, I'm hoping to add a red line to the legend for these plots (at 4552), to show the capacity of a reservoir in the context of different annual reservoir inflow projections under different climate change scenarios, on a slide for discussion purposes (I don't need to annotate the red line). There are quite a few reservoirs, so if possible I'd like to do this all with R.
Thank you for any ideas.
Not sure how to add a custom line on gradient legend, but I do know how to add a custom tick label with custom color:
library(ggplot2)
ggplot(df, aes(x, y, color = y)) +
geom_point() +
scale_colour_gradient(breaks = c(-2, 0, 1.7, 2),
labels = c(-2, 0, "1.7 (important)", 2)) +
guides(color = guide_colorbar(barheight = 10,
label.theme = element_text(colour = c("black", "black",
"red", "black"),
angle = 0,
size = 12)))
Notice that the "1.7" label overlaps the "2" label. You can either do something like the following:
ggplot(df, aes(x, y, color = y)) +
geom_point() +
scale_colour_gradient(breaks = c(-2, 0, 1.7, 2),
labels = c(-2, 0, "<-- 1.7 (important)", 2)) +
guides(color = guide_colorbar(barheight = 10,
label.theme = element_text(colour = c("black", "black",
"red", "black"),
angle = 0,
size = 12)))
or adjust the horizontal position of the "1.7" label:
ggplot(df, aes(x, y, color = y)) +
geom_point() +
scale_colour_gradient(breaks = c(-2, 0, 1.7, 2),
labels = c(-2, 0, "1.7 (important)", 2)) +
guides(color = guide_colorbar(barheight = 10,
label.hjust = c(0, 0, 0.1, 0),
label.theme = element_text(colour = c("black", "black",
"red", "black"),
angle = 0,
size = 12)))
I'm trying to draw some arrows in the margin of a ggplot. From what I've read, you have to turn off the plot clipping to do that. However, when I do that, it deletes a line segment I have on my graph.
library(ggplot2)
library(ggrepel)
library(grid)
#----------------- Fake data practice --------------------- #
mydata <- data.frame(Labels = letters[1:14],
X_Values = seq(1, 14, 1),
Y_Values = rnorm(14, mean = 0, sd = 1),
Influence = seq(1, 14, 1))
mydata$Influencer <- factor(ifelse(mydata$Influence <= 3, 1, 0))
# --- Get min/max from data and use to set range at -1to1 or -2to2
chartMax <- ifelse(min(mydata$Y_Values) < -1 | max(mydata$Y_Values) > 1, 2, 1)
chartMin <- ifelse(chartMax == 1, -1, -2)
yTitle = "Some Title"
# --- Label setting, if greater than 0 nudge up, else nudge down
mydata$Nudger <- ifelse(mydata$Y_Values >= 0, .1, -.1)
p <- ggplot(mydata, aes(x = X_Values, y = Y_Values, group = Influencer)) +
geom_point(aes(size = Influencer, color = Influencer), shape = 18) +
geom_segment(x = 0, xend = 14, y = 0, yend = 0, color = "red", linetype = "dashed", size = 1.2, alpha = .5) +
geom_text_repel(aes(x = X_Values, y = Y_Values, label = Labels),
box.padding = .4,
point.padding = .2,
nudge_y = .1) +
scale_color_manual(values = c("grey", "blue")) +
scale_size_manual(values = c(4, 6)) +
scale_y_continuous(name = "", limits = c(chartMin, chartMax)) +
scale_x_continuous(name = yTitle,
limits = c(1, 15),
breaks = c(2,13),
labels = c("Lower", "Higher")) +
theme_classic() + theme(plot.margin = unit(c(1,3,1,2), "lines"),
legend.position="none",
axis.ticks.x=element_blank(),
axis.text.x = element_text(face = "bold"),
axis.title = element_text(face = "bold"),
axis.line.x = element_line(color = "blue"
,size = 1
,arrow =
arrow(length = unit(0.5, "cm"),
ends = "both"))) +
annotation_custom(
grob = linesGrob(arrow=arrow(type="open", ends="both", length=unit(0.5, "cm")), gp=gpar(col="blue", lwd=2)),
xmin = -1.4, xmax = -1.4, ymin = chartMin, ymax = chartMax
)
p
# Here it works and you see the red dashed line
# Turn off panel clipping
gt <- ggplot_gtable(ggplot_build(p))
gt$layout$clip[gt$layout$name == "panel"] <- "off"
grid.draw(gt)
Ideally, I want a blue arrow that runs alongside the y-axis in the margins. I think I've got that, but I can't loose my dashed red line that runs along the inside the graph.
I can't explain why this is happening (seems like a bug, I suggest raising an issue here), but I can confirm that the issue is related to the line alpha. If we delete the alpha = 0.5 argument from geom_segment then the clipping=off works without deleting the line: