I was trying to plot some predicted vs. actual data, something that resembles the following:
# Some random data
x <- seq(1: 10)
y_pred <- runif(10, min = -10, max = 10)
y_obs <- y_pred + rnorm(10)
# Faking a CI
Lo.95 <- y_pred - 1.96
Hi.95 <- y_pred + 1.96
my_df <- data.frame(x, y_pred, y_obs, Lo.95, Hi.95)
ggplot(my_df, aes(x = x, y = y_pred)) +
geom_line(aes(colour = "Forecasted Data"), size = 1.2) +
geom_point(aes(x = x, y = y_obs, colour = "Actual Data"), size = 3) +
geom_ribbon(aes(ymin=Lo.95, ymax=Hi.95, x=x, linetype = NA, colour = "Confidence Interval"), alpha=0.2) +
theme_grey() +
scale_colour_manual(
values = c("gray30", "blue", "red"),
guide = guide_legend(override.aes = list(
border=c(NA, NA, NA),
fill=c("gray30", "white", "white"),
linetype = c("blank", "blank", "solid"),
shape = c(NA, 19, NA))))
The plot looks like this:
The only issue I have with this plot is the red border surrounding the legend item symbol for the line (i.e. the forecasted data). Is there any way I can remove it without breaking the rest of my plot?
I think geom_ribbon was the problem. If we take its color & fill out of aes, everything looks fine
library(ggplot2)
# Some random data
x <- seq(1: 10)
y_pred <- runif(10, min = -10, max = 10)
y_obs <- y_pred + rnorm(10)
# Faking a CI
Lo.95 <- y_pred - 1.96
Hi.95 <- y_pred + 1.96
my_df <- data.frame(x, y_pred, y_obs, Lo.95, Hi.95)
m1 <- ggplot(my_df, aes(x = x, y = y_pred)) +
geom_point(aes(x = x, y = y_obs, colour = "Actual"), size = 3) +
geom_line(aes(colour = "Forecasted"), size = 1.2) +
geom_ribbon(aes(x = x, ymin = Lo.95, ymax = Hi.95),
fill = "grey30", alpha = 0.2) +
scale_color_manual("Legend",
values = c("blue", "red"),
labels = c("Actual", "Forecasted")) +
guides( color = guide_legend(
order = 1,
override.aes = list(
color = c("blue", "red"),
fill = c("white", "white"),
linetype = c("blank", "solid"),
shape = c(19, NA)))) +
theme_bw() +
# remove legend key border color & background
theme(legend.key = element_rect(colour = NA, fill = NA),
legend.box.background = element_blank())
m1
As we leave Confidence Interval out of aes, we no longer have its legend. One workaround is to create an invisible point and take one unused geom to manually create a legend key. Here we can use size/shape (credit to this answer)
m2 <- m1 +
geom_point(aes(x = x, y = y_obs, size = "Confidence Interval", shape = NA)) +
guides(size = guide_legend(NULL,
order = 2,
override.aes = list(shape = 15,
color = "lightgrey",
size = 6))) +
# Move legends closer to each other
theme(legend.title = element_blank(),
legend.justification = "center",
legend.spacing.y = unit(0.05, "cm"),
legend.margin = margin(0, 0, 0, 0),
legend.box.margin = margin(0, 0, 0, 0))
m2
Created on 2018-03-19 by the reprex package (v0.2.0).
A better way to address this question would be to specify show.legend = F option in the geom_ribbon(). This will eliminate the need for the second step for adding and merging the legend key for the confidence interval. Here is the code with slight modifications.
ggplot(my_dff, aes(x = x, y = y_pred)) +
geom_line(aes(colour = "Forecasted Data"), size = 1) +
geom_point(aes(x = x, y = y_obs, colour = "Actual Data"), size = 1) +
geom_ribbon(aes(ymin=Lo.95, ymax=Hi.95, x=x, linetype = NA, colour = "Confidence Interval"), alpha=0.2, show.legend = F) +
theme_grey() +
scale_colour_manual(
values = c("blue", "gray30", "red"))+
guides(color = guide_legend(
override.aes = list(linetype = c(1, 1, 0)),
shape = c(1, NA, NA),
reverse = T))
My plot
Credit to https://stackoverflow.com/users/4282026/marblo
for their answer to similar question.
Related
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")
This question already has an answer here:
ggplot2 add manual legend for two data series
(1 answer)
Closed 2 years ago.
I want to add manually a legend to ggplot in r. The problem of my code is that it does not show the right symbols (blue point, blue dashed line and red solid line). Here the code and the plot.
predict_ID1.4.5.6.7 <- predict(lm_mRNATime, ID1.4.5.6.7)
ID1.4.5.6.7$predicted_mRNA <- predict_ID1.4.5.6.7
colors <- c("data" = "Blue", "predicted_mRNA" = "red","fit"="Blue")
ggplot( data = ID1.4.5.6.7, aes(x=Time,y=mRNA,color="data")) +
geom_point()+
scale_x_discrete(limits=c('0','20','40','60','120'))+
labs(title="ID-1,ID-4,ID-5,ID-6,ID-7",y="mRNA", x="Time [min]", color = "Legend") +
scale_color_manual(values = colors)+
geom_line(aes(x=Time,y=predicted_mRNA,color="predicted_mRNA"),lwd=1.3)+
geom_smooth(method = "lm",aes(color="fit",lty=2),se=TRUE,lty=2)+
scale_color_manual(values = colors)+
theme(plot.title = element_text(hjust = 0.5),plot.subtitle = element_text(hjust = 0.5))
How can I modify the code in order to get the symbols associated to the plot in the legend ?
The hardest part here was recreating your data set for demonstration purposes. It's always better to add a reproducible example. Anyway, the following should be close:
library(ggplot2)
set.seed(123)
ID1.4.5.6.7 <- data.frame(Time = c(rep(1, 3),
rep(c(2, 3, 4, 5), each = 17)),
mRNA = c(rnorm(3, 0.1, 0.25),
rnorm(17, 0, 0.25),
rnorm(17, -0.04, 0.25),
rnorm(17, -0.08, 0.25),
rnorm(17, -0.12, 0.25)))
lm_mRNATime <- lm(mRNA ~ Time, data = ID1.4.5.6.7)
Now we run your code with the addition of a custom colour guide:
predict_ID1.4.5.6.7 <- predict(lm_mRNATime, ID1.4.5.6.7)
ID1.4.5.6.7$predicted_mRNA <- predict_ID1.4.5.6.7
colors <- c("data" = "Blue", "predicted_mRNA" = "red", "fit" = "Blue")
p <- ggplot( data = ID1.4.5.6.7, aes(x = Time, y = mRNA, color = "data")) +
geom_point() +
geom_line(aes(x = Time, y = predicted_mRNA, color = "predicted_mRNA"),
lwd = 1.3) +
geom_smooth(method = "lm", aes(color = "fit", lty = 2),
se = TRUE, lty = 2) +
scale_x_discrete(limits = c('0', '20', '40', '60', '120')) +
scale_color_manual(values = colors) +
labs(title = "ID-1, ID-4, ID-5, ID-6, ID-7",
y = "mRNA", x = "Time [min]", color = "Legend") +
guides(color = guide_legend(
override.aes = list(shape = c(16, NA, NA),
linetype = c(NA, 2, 1)))) +
theme(plot.title = element_text(hjust = 0.5),
plot.subtitle = element_text(hjust = 0.5),
legend.key.width = unit(30, "points"))
I am trying to reproduce this kind of Figure, with two densities, a first one pointing upwards and a second one pointing downwards. I would also like to have some blank space between the two densities.
Here is the code I am currently using.
library(hrbrthemes)
library(tidyverse)
library(RWiener)
# generating data
df <- rwiener(n = 1e2, alpha = 2, tau = 0.3, beta = 0.5, delta = 0.5)
df %>%
ggplot(aes(x = q) ) +
geom_density(
data = . %>% filter(resp == "upper"),
aes(y = ..density..),
colour = "steelblue", fill = "steelblue",
outline.type = "upper", alpha = 0.8, adjust = 1, trim = TRUE
) +
geom_density(
data = . %>% filter(resp == "lower"),
aes(y = -..density..), colour = "orangered", fill = "orangered",
outline.type = "upper", alpha = 0.8, adjust = 1, trim = TRUE
) +
# stimulus onset
geom_vline(xintercept = 0, lty = 1, col = "grey") +
annotate(
geom = "text",
x = 0, y = 0,
# hjust = 0,
vjust = -1,
size = 3, angle = 90,
label = "stimulus onset"
) +
# aesthetics
theme_ipsum_rc(base_size = 12) +
theme(axis.text.y = element_blank() ) +
labs(x = "Reaction time (in seconds)", y = "") +
xlim(0, NA)
Which results in something like...
How could I add some vertical space between the two densities to reproduce the above Figure?
If you want to try without faceting, you're probably best to just plot the densities as polygons with adjusted y values according to your desired spacing:
s <- 0.25 # set to change size of the space
ud <- density(df$q[df$resp == "upper"])
ld <- density(df$q[df$resp == "lower"])
x <- c(ud$x[1], ud$x, ud$x[length(ud$x)],
ld$x[1], ld$x, ld$x[length(ld$x)])
y <- c(s, ud$y + s, s, -s, -ld$y - s, -s)
df2 <- data.frame(x = x, y = y,
resp = rep(c("upper", "lower"), each = length(ud$x) + 2))
df2 %>%
ggplot(aes(x = x, y = y, fill = resp, color = resp) ) +
geom_polygon(alpha = 0.8) +
scale_fill_manual(values = c("steelblue", "orangered")) +
scale_color_manual(values = c("steelblue", "orangered"), guide = guide_none()) +
geom_vline(xintercept = 0, lty = 1, col = "grey") +
annotate(
geom = "text",
x = 0, y = 0,
# hjust = 0,
vjust = -1,
size = 3, angle = 90,
label = "stimulus onset"
) +
# aesthetics
theme_ipsum_rc(base_size = 12) +
theme(axis.text.y = element_blank() ) +
labs(x = "Reaction time (in seconds)", y = "")
you can try facetting
set.seed(123)
q=rbeta(100, 0.25, 1)
df_dens =data.frame(gr=1,
x=density(df$q)$x,
y=density(df$q)$y)
df_dens <- rbind(df_dens,
data.frame(gr=2,
x=density(df$q)$x,
y=-density(df$q)$y))
ggplot(df_dens, aes(x, y, fill = factor(gr))) +
scale_x_continuous(limits = c(0,1)) +
geom_area(show.legend = F) +
facet_wrap(~gr, nrow = 2, scales = "free_y") +
theme_minimal() +
theme(strip.background = element_blank(),
strip.text.x = element_blank(),
axis.text.y = element_blank(),
axis.title.y = element_blank())
The space between both plots can be increased using panel.spacing = unit(20, "mm"). Instead of facet_grid you can also try facet_grid(gr~., scales = "free_y")
I have the code below, and it works fine. The problem is, I would like to add "k" and plot a straight line similar to "z", but "k" is a vector of different numbers. Each element in "k" should be plotted as a line on the 3 facets created. If k was a singular value, I would just repeat the geom_segment() command with different y limits. Is there an easy way to do this? The final output should look like attached, assuming I could draw straight lines.
x <- iris[-1:-3]
bw <- 1
nbin <- 100
y <- head(iris, 50)[2]
z <- 1
k <- c(2, 3, 4)
ggplot(x, aes(x = Petal.Width)) +
geom_density(aes(y = bw *..count.., fill = Species), size = 1, alpha = 0.4) +
geom_segment(aes(x = 5, y = 250, xend = z, yend = 250, color = "red")) +
facet_wrap(~Species)+
scale_x_continuous(labels = scales::math_format(10^.x), limits = c(0, 5), expand = c(0,0)) +
scale_y_continuous(expand = c(0,0), limits = c(0, NA)) +
annotation_logticks(sides = "b", short=unit(-1,"mm"), mid=unit(-2,"mm"), long=unit(-3,"mm")) +
coord_cartesian(clip='off') + theme(panel.background = element_blank(),
panel.border = element_rect(colour = "black", fill=NA))
you can try this. Assuming that your plot is saved as p1.
k_data = data.frame(k, Species = levels(x$Species))
p1 + geom_segment(data = k_data, aes(x =5, y = 200, xend = k, yend = 200),
color = "blue", inherit.aes = F)
The idea is to create a dataframe with the columns k and Species and use this data exclusivley in a geom by setting inherit.aes = F
In this solution, the value of k is made part of the data set being plotted through a pipe. It is a temporary modification of the data set, since it is not assigned back to it nor to any other data set.
library(ggplot2)
library(dplyr)
x <- iris[-1:-3]
str(x)
bw <- 1
nbin <- 100
y <- head(iris, 50)[2]
z <- 1
k <- c(2, 3, 4)
x %>%
mutate(k = rep(k, each = 50)) %>%
ggplot(aes(x = Petal.Width)) +
geom_density(aes(y = bw *..count.., fill = Species), size = 1, alpha = 0.4) +
geom_segment(aes(x = 5, y = 250, xend = z, yend = 250), color = "red") +
geom_segment(aes(x = 5, y = 200, xend = k, yend = 200), color = "blue") +
facet_wrap(~Species)+
scale_x_continuous(labels = scales::math_format(10^.x), limits = c(0, 5), expand = c(0,0)) +
scale_y_continuous(expand = c(0,0), limits = c(0, NA)) +
annotation_logticks(sides = "b", short=unit(-1,"mm"), mid=unit(-2,"mm"), long=unit(-3,"mm")) +
coord_cartesian(clip='off') +
theme(panel.background = element_blank(),
panel.border = element_rect(colour = "black", fill=NA))
I'm trying to create a Venn diagram where each circle has a unique colour, and the intersections blend those colours.
I can make the circles with the ggforce package. And I can blend the colours by setting the alpha values to, say, 0.75:
library(ggplot2)
library(ggforce)
propositions <- data.frame(
cirx = c(-.75 , .75),
ciry = c(0 , 0),
r = c(1.5 , 1.5),
labx = c(-2.25 , 2.25),
laby = c(1 , 1),
labl = c("A", "B")
)
ggplot(propositions) +
theme_void() + coord_fixed() +
xlim(-3,3) + ylim(-2,2) +
theme(panel.border = element_rect(colour = "black", fill = NA, size = 1)) +
geom_circle(aes(x0 = cirx, y0 = ciry, r = r), fill = "red", alpha = .6, data = propositions[1,]) +
geom_circle(aes(x0 = cirx, y0 = ciry, r = r), fill = "blue", alpha = .6, data = propositions[2,]) +
geom_text(aes(x = labx, y = laby, label = labl),
fontface = "italic", size = 10, family = "serif")
But the results are pretty poor:
The colours are washed out, and the intersection's colour isn't as distinct from the right-side circle's as I'd like. I want something closer to this (photoshopped) result:
I could do this if there was some way to designate and fill the intersection. In principle, this could be done with geom_ribbon(), I think. But that seems painful, and hacky. So I'm hoping for a more elegant solution.
Here's the workaround using geom_ribbon(). It's not a proper solution though, since it won't generalize to other shapes and intersections without manually redefining the boundaries of the ribbon, which can get real hairy fast.
There's gotta be a way to get ggplot2 to automatically do the work of blending colours across layers, right?
library(ggplot2)
library(ggforce)
x <- seq(-.75, .75, 0.01)
upper <- function(x) {
a <- sqrt(1.5^2 - (x[x < 0] - .75)^2)
b <- sqrt(1.5^2 - (x[x >= 0] + .75)^2)
c(a,b)
}
lower <- function(x) {
-upper(x)
}
ggplot() +
coord_fixed() + theme_void() +
xlim(-3,3) + ylim(-2,2) +
geom_circle(aes(x0 = -.75, y0 = 0, r = 1.5), fill = "red") +
geom_circle(aes(x0 = .75, y0 = 0, r = 1.5), fill = "blue") +
geom_ribbon(aes(x = x, ymin = upper(x), ymax = lower(x)), fill = "purple", colour = "black") +
theme(panel.border = element_rect(colour = "black", fill = NA, size = 1)) +
geom_text(aes(x = c(-2.25, 2.25), y = c(1, 1), label = c("A", "B")),
fontface = "italic", size = 10, family = "serif")