Wrong coloring in ggplot line graphs - ggplot2

I have created a ggplot graph with three lines. Each line represents a different column in a data frame and colored in a different color. For some reason, the colors in the final graph are not coordinated to the code.
The data frame:
Scenario 1 Scenario 2 Scenario 3 Years
0.0260 0.0340 0.0366 1
0.0424 0.0562 0.0696 2
0.0638 0.0878 0.1150 3
0.0848 0.1280 0.1578 4
0.1096 0.1680 0.2074 5
0.1336 0.2106 0.2568 6
This is the code:
ggplot(ext2, aes(x = Years))+
geom_line(aes(y = `Scenario 1`, color = "darkblue"))+
geom_line(aes(y = `Scenario 2`, color = "darkred"))+
geom_line(aes(y = `Scenario 3`, color = "darkgreen"))+
xlab("Years")+
ylab("Quasi - extinction probability")+
ggtitle("2 mature individuals")+
geom_segment(aes(x = 45,y = 0.5, xend = 45, yend = 1.1),linetype = "longdash")+
geom_segment(aes(x = 75,y = 0.2, xend = 75, yend = 0.5),linetype = "longdash")+
geom_segment(aes(x = 0,y = 0.5, xend = 100, yend = 0.5),linetype = "longdash")+
geom_segment(aes(x = 0,y = 0.2, xend = 100, yend = 0.2),linetype = "longdash")+
geom_text(x = 20, y = 0.80, label = "CE")+
geom_text(x = 40, y = 0.35, label = "EN")+
scale_colour_manual(values = c("darkblue", "darkred","darkgreen"), labels = c("Scenario 1","Scenario 2","Scenario 3"))+
theme(legend.title = element_blank())+
theme_minimal()
and this is the graph:
Click here to see graph
The problem is that what I defined as 'scenario 3' in the code is actually a representation of 'scenario 2' in the data frame. You can see it according to the values under scenario 2 in the data frame.

For ggplot, the data needs to be in long format before you plot. Then, you can make "Scenarios" (i.e., name) the group, so that you can manually color the individual lines (i.e., with scale_colour_manual).
library(tidyverse)
ext_long <- ext2 %>%
pivot_longer(!Years)
ggplot(ext_long, aes(x = Years, color = name)) +
geom_line(aes(y = value)) +
xlab("Years") +
ylab("Quasi - extinction probability") +
ggtitle("2 mature individuals") +
geom_segment(aes(
x = 45,
y = 0.5,
xend = 45,
yend = 1.1
), linetype = "longdash") +
geom_segment(aes(
x = 75,
y = 0.2,
xend = 75,
yend = 0.5
), linetype = "longdash") +
geom_segment(aes(
x = 0,
y = 0.5,
xend = 100,
yend = 0.5
), linetype = "longdash") +
geom_segment(aes(
x = 0,
y = 0.2,
xend = 100,
yend = 0.2
), linetype = "longdash") +
geom_text(x = 20, y = 0.80, label = "CE") +
geom_text(x = 40, y = 0.35, label = "EN") +
scale_colour_manual(
values = c("darkblue", "darkred", "darkgreen"),
labels = c("Scenario 1", "Scenario 2", "Scenario 3")
) +
theme(legend.title = element_blank()) +
theme_minimal()
Output (only have a small part of the data, which is the reason the lines do not extend across the graph)
Data
ext2 <- structure(
list(
Scenario.1 = c(0.026, 0.0424, 0.0638, 0.0848,
0.1096, 0.1336),
Scenario.2 = c(0.034, 0.0562, 0.0878, 0.128,
0.168, 0.2106),
Scenario.3 = c(0.0366, 0.0696, 0.115, 0.1578,
0.2074, 0.2568),
Years = 1:6
),
class = "data.frame",
row.names = c(NA,-6L)
)

Related

Why are Y axis labels offset in ggplot?

The Y axis labels are offset
The Y axis labels from 100 to the top are aligned to the right, while from 90 to the bottom are aligned to the left. I've looked at many paramaters and I couldn't find one to be causing this. Also, I haven't found anyone else with this same issue.
Here's my code:
test <- ggplot(data,
aes(x=Month, y=Value, color=Name, group=Name, fill=Name))+
geom_line(size=3)+
geom_point(size=5)+
scale_color_manual(values=c("#FBE785","#0F5F00","#FFC300","#1BFFAA"))+
ylab ("")+
xlab ("")+
labs(caption = paste("Fonte: Fred e IBGE.")) +
scale_x_date(date_labels = "%b/%y", breaks = "6 month", expand=c(0,0))+
coord_cartesian(clip = "off")+
theme_minimal() +
guides(fill=guide_legend())+
theme(panel.background = element_rect(fill= "#122929",color = "#122929"),
plot.background = element_rect(fill = "#122929"),
panel.grid.major = element_line(color = "#4D4B55", size =0.1),
panel.grid.minor = element_line(color= "#4D4B55", size =0.1),
panel.grid = element_blank(),
axis.text.y = element_text(vjust = 1, hjust=-1),
axis.text.x = element_text(vjust = -1, hjust=0),
legend.title = element_blank(),
legend.position = "bottom",
legend.key.width = unit(1.5, "cm"),
plot.caption = element_text(family = "Abel",vjust = -1, hjust = 0,colour="#4D4B55", size= 30),
text = element_text(family = "Abel", color = "#4D4B55",size = 35),
plot.margin = margin(1,1,1.5,1.2, "cm"))
ggsave("./test.png", width = 21, height = 15, dpi = 300)
PS: Not sharing the data itself because I guess that's not where the problem is.
Thanks!
Your text is misaligned because of your axis.text.y argument. Change hjust to 1 and it will be properly aligned. I have provided a minimal reproducible example below.
library(tidyverse)
Month <- rep(x = month.abb, times = 10)
Value <- sample(x = 10:120, size = 120, replace = TRUE)
Name <- sample(x = LETTERS[1:4], size = 120, replace = TRUE)
data <- data.frame(Month, Value, Name)
ggplot(data, aes(x = Month, y = Value, color = Name, group = Name, fill = Name)) +
geom_line(size = 1) + geom_point(size = 2) +
theme(axis.text.y = element_text(vjust = 1, hjust = 1)) # <- problem here

Add linetype to geom_segment legend

Aim: add the linetypes of the segments to the legend, as well as the colour.
Problem: only the colour is showing.
Data:
m = as.data.frame(matrix(c(1:10), ncol = 2, nrow = 10))
Plot:
ggplot(m, aes(v1,v2)) + geom_segment(aes(x = 0, xend = 9.75, y = 10, yend = 10, colour = "PEL"), linetype = "dotted") + geom_segment(aes(x = 0, xend = 9.75, y = 5, yend = 5, colour = "AL1"), linetype = "longdash") + geom_segment(aes(x = 0, xend = 9.75, y = 2, yend = 2, colour = "ISQG"), linetype = "solid") + scale_colour_manual("legend", values = c("PEL" = "black", "AL1" = "blue", "ISQG" = "purple"), guide = guide_legend(override.aes = list(alpha = 1))) + theme(legend.position = "bottom")
I've tried adding scale_linetype_manual(values = c("PEL" = "dotted", "AL1" = "longdash", "ISQG" = "solid") but nothing changes.
This answer is similar, Legend linetype in ggplot but I couldn't figure out how to make it work with geom_segment
Thank you in advance
The most ggplot-esque way of doing this, is to include a linetype variable as part of mapping in the aes() functions. You must then ensure that both the linetype and colour scales have the same titles, breaks, limits, labels etc.
Alternatively, you can also include the linetype in the override.aes part of guide_legend().
library(ggplot2)
ggplot() +
geom_segment(
aes(x = 0, xend = 9.75, y = 10, yend = 10, colour = "PEL", linetype ="PEL"),
) +
geom_segment(
aes(x = 0, xend = 9.75, y = 5, yend = 5, colour = "AL1", linetype ="AL1"),
) +
geom_segment(
aes(x = 0, xend = 9.75, y = 2, yend = 2, colour = "ISQG", linetype = "ISQG"),
) +
scale_colour_manual(
"legend",
values = c("PEL" = "black", "AL1" = "blue", "ISQG" = "purple"),
) +
scale_linetype_manual(
"legend",
values = c("PEL" = "dotted", "AL1" = "longdash", "ISQG" = "solid"),
) +
theme(legend.position = "bottom")
Created on 2022-05-19 by the reprex package (v2.0.1)

Facet title left alignment using facet_grid

I'm making a plot with facets where the length of facet titles vary quite a bit. I am trying to left-align the facet/strip title with hjust, but it seems like hjust adjust differently depending on length of each facet title. Ideally, I would like to align each facet title with the 0 on the axis.
library(ggplot2)
data <- data.frame(q = c(rep("q1", 16), rep("question mucher longer and longer and longer", 16)),
cat = c(rep(paste0("cat", 1:4), times = 8)),
p = rep(25, 32),
group = c(rep(paste0("group", 1:4), each = 4),
c(rep(paste0("group", 1:4), each = 4))))
ggplot(data = data,
aes(x = group, y = p, fill = cat, label = p)) +
geom_bar(stat="identity", position = position_stack(), width=0.6) +
facet_grid(col = vars(q)) +
coord_flip() +
geom_text(position = position_stack(vjust = 0.5), size = 3.5, color= "black") +
xlab("") +
ylab("") +
theme_minimal(base_size=12) +
theme(
legend.position="bottom",
panel.grid.major.y = element_blank(),
panel.grid.major.x = element_line( size=.1, color="gray"),
panel.grid.minor.x = element_line( size=.1, color="gray"),
strip.text = element_text(face="bold", hjust=0.03)) +
guides(fill = guide_legend(reverse=TRUE)) +
scale_y_continuous(labels=c("0","25","50","75","100 %")) +
geom_hline(yintercept = 0, color = "gray23") +
geom_hline(yintercept = 100, color = "gray23") +
theme(legend.title=element_blank(),
legend.margin=margin(0,0,0,0),
legend.box.margin=margin(-10,0,0,0))
The issue is the expansion of the y scale. Hence, the strip text box expands over the 0 line. To fix your issue use hjust=0 for the strip box text and remove the default expansion on the left (or bottom in your case) of the y scale. To show this clearer I added a red box around the strip text boxes:
library(ggplot2)
ggplot(
data = data,
aes(x = group, y = p, fill = cat, label = p)
) +
geom_bar(stat = "identity", position = position_stack(), width = 0.6) +
facet_grid(col = vars(q)) +
coord_flip() +
geom_text(position = position_stack(vjust = 0.5), size = 3.5, color = "black") +
xlab("") +
ylab("") +
theme_minimal(base_size = 12) +
theme(
legend.position = "bottom",
panel.grid.major.y = element_blank(),
panel.grid.major.x = element_line(size = .1, color = "gray"),
panel.grid.minor.x = element_line(size = .1, color = "gray"),
strip.text = element_text(face = "bold", hjust = 0, margin = margin(0, 0, 0, 0, "pt")),
strip.background.x = element_rect(color = "red")
) +
guides(fill = guide_legend(reverse = TRUE)) +
scale_y_continuous(labels = c("0", "25", "50", "75", "100 %"), expand = c(0, 0, .05, 0)) +
geom_hline(yintercept = 0, color = "gray23") +
geom_hline(yintercept = 100, color = "gray23") +
theme(
legend.title = element_blank(),
legend.margin = margin(0, 0, 0, 0),
legend.box.margin = margin(-10, 0, 0, 0)
)

The second description of the x-axis in ggplot2?

I am wondering if there is a way to add the second description of x-axis in ggplot2 as follows: Here "the second description" refers "Sample A / Sample B / two arrows" colored in red (shown in the figure).
Please click for the figure!
Of course, I can just put the "second description" using PowerPoint as I did, but I just wonder if it is possible to add it using ggplot2.
Here is the code for the background plot.
library(ggplot2)
library(ggridges)
x <- data.frame(v1=rnorm(100, mean = -2, sd = 0.022),
v2=rnorm(100, mean = -1, sd = 0.022),
v3=rnorm(100, mean = 0, sd = 0.022),
v4=rnorm(100, mean = 1, sd = 0.022),
v5=rnorm(100, mean = 2, sd = 0.022),
v6=rnorm(100, mean = 3, sd = 0.022),
v7=rnorm(100, mean = 4, sd = 0.022))
colnames(x) <- c("A",
"B",
"C",
"D",
"E",
"F",
"G")
head(x)
# Manipulate the data
library(reshape2)
data <- melt(x)
head(data)
# Generating plot
colors <- rainbow(7)
ggplot(data, aes(x = value, y = variable)) +
geom_density_ridges(aes(fill = variable), alpha=0.6, bandwidth=0.1) +
scale_fill_manual(values = colors)+
theme(axis.title = element_text(size = 12),
axis.text = element_text(size = 10),
legend.text = element_text(size = 12),
plot.title = element_text(size = 17, face = "bold",
margin = margin(b=10), hjust = 0.5),
panel.spacing = unit(0.1, "lines"),
legend.position="none") +
geom_vline(xintercept = 0, linetype="dotted") +
geom_vline(xintercept = 2, linetype="dotted",
color = "red", size=1.2) +
xlab("") +
ylab("Groups") +
labs(title = 'Density plot of each group')
Thank you in advance!
I'm not 100% sure this is what you mean, but you can add text on the x-axis using the following in labs:
labs(x="← Sample A Sample B →")
I got the arrows from unicode here: http://xahlee.info/comp/unicode_arrows.html
There are bigger arrows in the link if needed.
EDIT:
Here's your code adapted with the new labels in red font:
ggplot(data, aes(x = value, y = variable)) +
geom_density_ridges(aes(fill = variable), alpha=0.6, bandwidth=0.1) +
scale_fill_manual(values = colors)+
theme(axis.title = element_text(size = 12),
axis.text = element_text(size = 10),
legend.text = element_text(size = 12),
plot.title = element_text(size = 17, face = "bold",
margin = margin(b=10), hjust = 0.5),
panel.spacing = unit(0.1, "lines"),
legend.position="none") +
geom_vline(xintercept = 0, linetype="dotted") +
geom_vline(xintercept = 2, linetype="dotted",
color = "red", size=1.2) +
xlab("🢀 Sample A Sample B 🢂") +
theme(axis.title.x = element_text(size=40,colour = "red")) +
ylab("Groups") +
labs(title = 'Density plot of each group')
You can also push the labels further apart by adding extra spaces. Bring them closer together with fewer spaces.

Create a ggplot2 survival curve with censored table

I am trying to create a Kaplan-Meier plot with 95% confidence bands plus having the censored data in a table beneath it. I can create the plot, but not the table. I get the error message: Error in grid.draw(both) : object 'both' not found.
library(survival)
library(ggplot2)
library(GGally)
library(gtable)
data(lung)
sf.sex <- survfit(Surv(time, status) ~ sex, data = lung)
pl.sex <- ggsurv(sf.sex) +
geom_ribbon(aes(ymin=low,ymax=up,fill=group),alpha=0.3) +
guides(fill=guide_legend("sex"))
pl.sex
tbl <- ggplot(df_nums, aes(x = Time, y = factor(variable), colour = variable,+
label=value)) +
geom_text() +
theme_bw() +
theme(panel.grid.major = element_blank(),+
legend.position = "none",+
plot.background = element_blank(), +
panel.grid.major = element_blank(),+
panel.grid.minor = element_blank(),+
panel.border = element_blank(),+
legend.position="none",+
axis.line = element_blank(),+
axis.text.x = element_blank(),+
axis.text.y = element_text(size=15, face="bold", color = 'black'),+
axis.ticks=element_blank(),+
axis.title.x = element_blank(),+
axis.title.y = element_blank(),+
plot.title = element_blank()) +
scale_y_discrete(breaks=c("Group.A", "Group.B"), labels=c("Group A", "Group B"))
both = rbind(ggplotGrob(g), ggplotGrob(tbl), size="last")
panels <- both$layout$t[grep("panel", both$layout$name)]
both$heights[panels] <- list(unit(1,"null"), unit(2, "lines"))
both <- gtable_add_rows(both, heights = unit(1,"line"), 8)
both <- gtable_add_grob(both, textGrob("Number at risk", hjust=0, x=0), t=9, l=2, r=4)
grid.newpage()
grid.draw(both)
I solved the problem by using the Rcmdrplugin KMggplot2 The code is generated by the plugin after selecting the data and variables.
library(survival, pos=18)
data(lung, package="survival")
lung <- within(lung, {
sex <- factor(sex, labels=c('male','female'))
})
ggthemes_data <- ggthemes::ggthemes_data
require("ggplot2")
.df <- na.omit(data.frame(x = lung$time, y = lung$status, z = lung$sex))
.df <- .df[do.call(order, .df[, c("z", "x"), drop = FALSE]), , drop = FALSE]
.fit <- survival::survfit(survival::Surv(time = x, event = y, type = "right") ~ z,
.df)
.pval <- plyr::ddply(.df, plyr::.(),
function(x) {
data.frame(
x = 0, y = 0, df = 1,
chisq = survival::survdiff(
survival::Surv(time = x, event = y, type = "right") ~ z, x
)$chisq
)})
.pval$label <- paste0(
"paste(italic(p), \" = ",
signif(1 - pchisq(.pval$chisq, .pval$df), 3),
"\")"
)
.fit <- data.frame(x = .fit$time, y = .fit$surv, nrisk = .fit$n.risk, nevent =
.fit$n.event, ncensor= .fit$n.censor, upper = .fit$upper, lower = .fit$lower)
.df <- .df[!duplicated(.df[,c("x", "z")]), ]
.df <- .fit <- data.frame(.fit, .df[, c("z"), drop = FALSE])
.med <- plyr::ddply(.fit, plyr::.(z), function(x) {
data.frame(
median = min(subset(x, y < (0.5 + .Machine$double.eps^0.5))$x)
)})
.df <- .fit <- rbind(unique(data.frame(x = 0, y = 1, nrisk = NA, nevent = NA,
ncensor = NA, upper = 1, lower = 1, .df[, c("z"), drop = FALSE])), .fit)
.cens <- subset(.fit, ncensor == 1)
.tmp1 <- data.frame(as.table(by(.df, .df[, c("z"), drop = FALSE], function(d)
max(d$nrisk, na.rm = TRUE))))
.tmp1$x <- 0
.nrisk <- .tmp1
for (i in 1:9) {.df <- subset(.fit, x < 100 * i); .tmp2 <-
data.frame(as.table(by(.df, .df[, c("z"), drop = FALSE], function(d) if
(all(is.na(d$nrisk))) NA else min(d$nrisk - d$nevent - d$ncensor, na.rm = TRUE))));
.tmp2$x <- 100 * i; .tmp2$Freq[is.na(.tmp2$Freq)] <- .tmp1$Freq[is.na(.tmp2$Freq)];
.tmp1 <- .tmp2; .nrisk <- rbind(.nrisk, .tmp2)}
.nrisk$y <- rep(seq(0.075, 0.025, -0.05), 10)
.plot <- ggplot(data = .fit, aes(x = x, y = y, colour = z)) +
RcmdrPlugin.KMggplot2::geom_stepribbon(data = .fit, aes(x = x, ymin = lower, ymax =
upper, fill = z), alpha = 0.25, colour = "transparent", show.legend = FALSE, kmplot
= TRUE) + geom_step(size = 1.5) +
geom_linerange(data = .cens, aes(x = x, ymin = y,
ymax = y + 0.02), size = 1.5) +
geom_text(data = .pval, aes(y = y, x = x, label =
label), colour = "black", hjust = 0, vjust = -0.5, parse = TRUE, show.legend =
FALSE, size = 14 * 0.282, family = "sans") +
geom_vline(data = .med, aes(xintercept
= median), colour = "black", lty = 2) + scale_x_continuous(breaks = seq(0, 900, by
= 100), limits = c(0, 900)) +
scale_y_continuous(limits = c(0, 1), expand = c(0.01,0)) + scale_colour_brewer(palette = "Set1") + scale_fill_brewer(palette = "Set1") +
xlab("Time from entry") + ylab("Proportion of survival") + labs(colour = "sex") +
ggthemes::theme_calc(base_size = 14, base_family = "sans") + theme(legend.position
= c(1, 1), legend.justification = c(1, 1))
.nrisk$y <- ((.nrisk$y - 0.025) / (max(.nrisk$y) - 0.025) + 0.5) * 0.5
.plot2 <- ggplot(data = .nrisk, aes(x = x, y = y, label = Freq, colour = z)) +
geom_text(size = 14 * 0.282, family = "sans") + scale_x_continuous(breaks = seq(0,900, by = 100), limits = c(0, 900)) +
scale_y_continuous(limits = c(0, 1)) +
scale_colour_brewer(palette = "Set1") + ylab("Proportion of survival") +
RcmdrPlugin.KMggplot2::theme_natrisk(ggthemes::theme_calc, 14, "sans")
.plot3 <- ggplot(data = subset(.nrisk, x == 0), aes(x = x, y = y, label = z, colour = z)) +
geom_text(hjust = 0, size = 14 * 0.282, family = "sans") +
scale_x_continuous(limits = c(-5, 5)) + scale_y_continuous(limits = c(0, 1)) +
scale_colour_brewer(palette = "Set1") +
RcmdrPlugin.KMggplot2::theme_natrisk21(ggthemes::theme_calc, 14, "sans")
.plotb <- ggplot(.df, aes(x = x, y = y)) + geom_blank() +
RcmdrPlugin.KMggplot2::theme_natriskbg(ggthemes::theme_calc, 14, "sans")
grid::grid.newpage(); grid::pushViewport(grid::viewport(layout =
grid::grid.layout(2, 2, heights = unit(c(1, 3), c("null", "lines")), widths =
unit(c(4, 1), c("lines", "null")))));
print(.plotb, vp =
grid::viewport(layout.pos.row = 1:2, layout.pos.col = 1:2));
print(.plot , vp =
grid::viewport(layout.pos.row = 1 , layout.pos.col = 1:2));
print(.plot2, vp =
grid::viewport(layout.pos.row = 2 , layout.pos.col = 1:2));
print(.plot3, vp =
grid::viewport(layout.pos.row = 2 , layout.pos.col = 1 ));
.plot <- recordPlot()
print(.plot)
Here's a start (code below)
I guess you can create the table need and replace it by the random.table
# install.packages("ggplot2", dependencies = TRUE)
# install.packages("RGraphics", dependencies = TRUE)
# install.packages("gridExtra", dependencies = TRUE)
# install.packages("survival", dependencies = TRUE)
require(ggplot2)
library(RGraphics)
library(gridExtra)
library(survival)
# Plot
data(lung)
sf.sex <- survfit(Surv(time, status) ~ sex, data = lung)
pl.sex <- ggsurv(sf.sex) +
geom_ribbon(aes(ymin=low,ymax=up,fill=group),alpha=0.3) +
guides(fill=guide_legend("sex"))
# Table
random.table <- data.frame("CL 95"=rnorm(5),n=runif(5,1,3))
pl.table <- tableGrob(random.table)
# Arrange the plots on the same page
grid.arrange(pl.sex, pl.table, ncol=1)