library(tidyverse)
ggplot(data = data.frame(x = c(0, 1)), aes(x)) +
geom_function(fun = dnorm, n = 10001,
args = list(mean = .5, sd = .125),
show.legend = T) +
geom_function(fun = dbeta, n = 10001,
args = list(shape1 = 10, shape2 = 8),
linetype = 5, show.legend = T) +
geom_function(fun = dbeta, n = 10001,
args = list(shape1 = 15, shape2 = 8),
linetype = 2, show.legend = T) +
geom_function(fun = dbeta, n = 10001,
args = list(shape1 = 20, shape2 = 8),
linetype = 3, show.legend = T) +
ylab("f(θ)") +
xlab("θ") +
scale_linetype_manual(
values = c("a" = 1,
"b" = 5,
"c" = 2,
"d" = 3)
)+
theme_test(base_size = 20)
If you plot this, the legend will not take the correct linetypes. It will always show the linetype "1" or "solid".
How do I show different correct linetypes in scale_linetype_manual()?
If you want to have a legend you have to map on aesthetics, i.e. instead of setting the linetype as parameter set it inside aes() and use the labels you used in scale_linetype_manual:
Note: Doing we could get rid of show.legend=T as ggplot will automatically add a legend.
library(ggplot2)
ggplot(data = data.frame(x = c(0, 1)), aes(x)) +
geom_function(aes(linetype = "a"), fun = dnorm, n = 10001,
args = list(mean = .5, sd = .125)) +
geom_function(aes(linetype = "b"), fun = dbeta, n = 10001,
args = list(shape1 = 10, shape2 = 8)) +
geom_function(aes(linetype = "c"), fun = dbeta, n = 10001,
args = list(shape1 = 15, shape2 = 8)) +
geom_function(aes(linetype = "d"), fun = dbeta, n = 10001,
args = list(shape1 = 20, shape2 = 8)) +
ylab("f(θ)") +
xlab("θ") +
scale_linetype_manual(
values = c("a" = 1,
"b" = 5,
"c" = 2,
"d" = 3)
)+
theme_test(base_size = 20)
EDIT Instead of mapping on the linetype aesthetic another option would be to set your desired linetype via the override.aes argument of guide_legend. This could also be used to set different colors or ... . But be aware that doing so you have to set the linetypes in the order the categories appear in the legend:
Note: The assignment of linetype via the scale does not work. For this we have to map on aesthetics.
library(ggplot2)
ggplot(data = data.frame(x = c(0, 1)), aes(x)) +
geom_function(fun = dnorm, n = 10001,
args = list(mean = .5, sd = .125),
show.legend = T, linetype = 3) +
geom_function(fun = dbeta, n = 10001,
args = list(shape1 = 10, shape2 = 8),
linetype = 5) +
geom_function(fun = dbeta, n = 10001,
args = list(shape1 = 15, shape2 = 8),
linetype = 2) +
geom_function(fun = dbeta, n = 10001,
args = list(shape1 = 20, shape2 = 8),
linetype = 3) +
ylab("f(θ)") +
xlab("θ") +
scale_linetype_manual(
values = c("a" = 1,
"b" = 2,
"c" = 2,
"d" = 3)
)+
theme_test(base_size = 20) +
guides(linetype = guide_legend(override.aes = list(linetype = c(1, 5, 2, 3), color = c(1, 5, 2, 3))))
Related
I have a plot made with ggplot where the legends adds extra black points to all the other legends (see image).
library(tidyverse)
library(ggnewscale)
set.seed(12345)
brks = c(0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1)
fd = expand.grid(x = seq(6,16, length.out = 100),
y = seq(6,18, length.out = 100))
fd$z = sample(x = seq(0,1, length.out = 100), size = nrow(fd), replace = T)
df.t = data.frame(s = LETTERS[1:5], l = c(11,12,8,15,14), d = c(13,10,7,16,8))
mypal = data.frame(A = "black", B = "red",C = "blue", D = "green", E = "yellow")
summmmmmmm = expand.grid(s = LETTERS[1:5],
yr = 1995:2012)
summmmmmmm$yr = as.factor(summmmmmmm$yr)
summmmmmmm$l = NA
summmmmmmm$d = NA
summmmmmmm[summmmmmmm$s == "A","l"] = rnorm(n = 18, mean = 11, sd = .5)
summmmmmmm[summmmmmmm$s == "B","l"] = rnorm(n = 18, mean = 12, sd = .5)
summmmmmmm[summmmmmmm$s == "C","l"] = rnorm(n = 18, mean = 8, sd = .5)
summmmmmmm[summmmmmmm$s == "D","l"] = rnorm(n = 18, mean = 15, sd = .5)
summmmmmmm[summmmmmmm$s == "E","l"] = rnorm(n = 18, mean = 14, sd = .5)
summmmmmmm[summmmmmmm$s == "A","d"] = rnorm(n = 18, mean = 13, sd = .5)
summmmmmmm[summmmmmmm$s == "B","d"] = rnorm(n = 18, mean = 10, sd = .5)
summmmmmmm[summmmmmmm$s == "C","d"] = rnorm(n = 18, mean = 8, sd = .5)
summmmmmmm[summmmmmmm$s == "D","d"] = rnorm(n = 18, mean = 16, sd = .5)
summmmmmmm[summmmmmmm$s == "E","d"] = rnorm(n = 18, mean = 9, sd = .5)
ggplot(data = fd, mapping = aes(x = x, y = y, z = z)) +
geom_contour_filled(breaks = brks)+
geom_point(data = df.t,
mapping = aes(x = l, y = d, color = s), inherit.aes = FALSE, size = 5) +
scale_fill_manual(values = alpha(hcl.colors(100, "YlOrRd", rev = TRUE, alpha = 1), .99))+
scale_color_manual(values = alpha(mypal,1),
name = "obj")+
new_scale_color() +
geom_point(data = summmmmmmm,
mapping = aes(x = l, y = d,
color = yr, group = s),
shape = 19,
inherit.aes = FALSE,
show.legend = TRUE) +
geom_path(data = summmmmmmm[order(summmmmmmm$yr),],
mapping = aes(x = l, y = d, color = yr,
group = as.factor(s)), inherit.aes = FALSE,
show.legend = FALSE) +
scale_color_viridis_d(name = "time")
I'd like to get rid of those extra points. Also, I like the 'time' legend to be in 2 columns, but not the other legends. Is there a way to do this?
You need to use guide = guide_legend(ncol = 2) in your viridis scale to get two columns.
You can set show.legend = c(colour = TRUE, fill = FALSE) in the second point layer, to specifically show the legend in colour scales but not in fill scales.
See example below (where I've renamed summmmmmmm to df for my own sanity)
ggplot(data = fd, mapping = aes(x = x, y = y, z = z)) +
geom_contour_filled(breaks = brks)+
geom_point(
data = df.t,
mapping = aes(x = l, y = d, color = s), inherit.aes = FALSE, size = 5
) +
scale_fill_manual(
values = alpha(hcl.colors(100, "YlOrRd", rev = TRUE, alpha = 1), .99)
)+
scale_color_manual(values = alpha(mypal,1), name = "obj")+
new_scale_color() +
geom_point(
data = df,
mapping = aes(x = l, y = d, color = yr, group = s),
shape = 19, inherit.aes = FALSE,
show.legend = c(colour = TRUE, fill = FALSE)
) +
geom_path(
data = df[order(df$yr),],
mapping = aes(x = l, y = d, color = yr, group = as.factor(s)),
inherit.aes = FALSE, show.legend = FALSE
) +
scale_color_viridis_d(name = "time", guide = guide_legend(ncol = 2))
I have 2 normal probability plots as below
library(ggplot2)
# Plot 1
ggplot(data.frame(x = c(-4, 4)), aes(x)) +
stat_function(fun = dnorm, args = list(mean = 0, sd = 1), col='red') +
stat_function(fill='red', fun = dnorm, xlim = c(-4, -1), geom = "area") +
stat_function(fill='red', fun = dnorm, xlim = c(-1, 4), geom = "area", alpha = 0.3)
# Plot 2
ggplot(data.frame(x = c(-4, 4)), aes(x)) +
stat_function(fun = dnorm, args = list(mean = 0, sd = 2), col='blue') +
stat_function(fill='blue', fun = dnorm, args = list(mean = 0, sd = 2), xlim = c(-4, -1), geom = "area") +
stat_function(fill='blue', fun = dnorm, args = list(mean = 0, sd = 2), xlim = c(-1, 4), geom = "area", alpha = 0.3)
Individually they are just fine. However I wanted to combine these 2 plots and place them in same plot window with same x-axis.
I also want to add a legend based on fill color in the combined plot to distinguish them.
Is there any way to achieve this with ggplot?
Any pointer will be very helpful
You could combine both the stat_functions and create two with an aes for your fill to create a legend with scale_fill_manual like this:
library(ggplot2)
ggplot(data.frame(x = c(-4, 4)), aes(x)) +
stat_function(fun = dnorm, args = list(mean = 0, sd = 1), col='red') +
stat_function(fun = dnorm, xlim = c(-4, -1), geom = "area", aes(fill = "plot 1")) +
stat_function(fill='red', fun = dnorm, xlim = c(-1, 4), geom = "area", alpha = 0.3) +
stat_function(fun = dnorm, args = list(mean = 0, sd = 2), col='blue') +
stat_function(fun = dnorm, args = list(mean = 0, sd = 2), xlim = c(-4, -1), geom = "area", aes(fill = "plot 2")) +
stat_function(fill='blue', fun = dnorm, args = list(mean = 0, sd = 2), xlim = c(-1, 4), geom = "area", alpha = 0.3) +
scale_fill_manual(name = "Legend", values = c("red", "blue"))
Created on 2022-12-31 with reprex v2.0.2
How can I color the plots such that -
A1 - Dark blue,
A2 - Light blue,
B1 - Dark red,
B2 - Light red
tbl <- tibble(x = c(rnorm(n = 100, mean = 0, sd = 1),
rnorm(n = 100, mean = 0, sd = 0.5),
rnorm(n = 100, mean = 4, sd = 1),
rnorm(n = 100, mean = 4, sd = 0.5)),
y = c(rep("A1", 100),
rep("A2", 100),
rep("B1", 100),
rep("B2", 100))
)
ggplot(data = tbl,
aes(x = x,
fill = y)) +
geom_histogram(color = "black",
alpha = 0.5) +
theme_bw()
I arbitrarily chose the colors (Dark blue ~ Light Red).
You can change the colors manually using hexcode in sclae_fill_manual.
tbl <- tibble(x = c(rnorm(n = 100, mean = 0, sd = 1),
rnorm(n = 100, mean = 0, sd = 0.5),
rnorm(n = 100, mean = 4, sd = 1),
rnorm(n = 100, mean = 4, sd = 0.5)),
y = c(rep("A1", 100),
rep("A2", 100),
rep("B1", 100),
rep("B2", 100))
)
ggplot(data = tbl,
aes(x = x,
fill = y)) +
geom_histogram(color = "black",
alpha = 0.5) +
scale_fill_manual(values = c('#2C3FF6','#72B5FC','#F62C2C','#F0C3C3'))+
theme_bw()
#> `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Created on 2022-05-18 by the reprex package (v2.0.1)
Similar to the answer above but a little more verbose using a named vector of colors.
# Create a named vector of colors
# There is no R color named "light red" therefore I used red instead.
colours <- c(A1= "darkblue", A2="lightblue", B1= "darkred", B2= "red")
ggplot(data = tbl,
aes(x = x,
fill = y)) +
geom_histogram(color = "black",
alpha = 0.5) +
scale_fill_manual(values = colours) +
theme_bw()
I am trying to make a figure in ggplot where color, shape and size are mapped to a variable as follows: 0 values are shown as red crosses. Values > 0 are shown as circles with the circle size and color scaled to the variable (i.e. the larger the circle, the higher the value). I want to use a binned viridis scale for the color. The values mapped to color vary randomly, so the scaling should not be hardcoded. Here is the figure:
library(tidyverse)
x <- tibble(x = sample(1:100, 10), y = sample(1:100, 10), z = c(0, sample(1:1e6, 9)))
color_breaks <- sort(unique(c(0, 1, pretty(x$z, n = 5), ceiling(max(x$z)))))
ggplot(x, aes(x = x, y = y, color = z, shape = z == 0, size = z)) +
geom_point(stroke = 1.5) +
scale_shape_manual(values = c(`TRUE` = 3, `FALSE` = 21), guide = "none") +
scale_size(range = c(1, 8),
breaks = color_breaks,
limits = c(0, ceiling(max(x$z)))
) +
binned_scale(aesthetics = "color",
scale_name = "stepsn",
palette = function(x) c("red", viridis::viridis(length(color_breaks) - 3)),
limits = c(0, ceiling(max(x$z))),
breaks = color_breaks,
show.limits = TRUE
) +
guides(color = guide_legend(), size = guide_legend()) +
theme_bw()
Created on 2022-03-31 by the reprex package (v2.0.1)
How do I combine the variables to a single legend, which should look like this (edited in Illustrator)?
You can override the aesthetics inside guides:
x <- tibble(x = sample(1:100, 10), y = sample(1:100, 10), z = c(0, sample(1:1e6, 9)))
color_breaks <- sort(unique(c(0, pretty(x$z, n = 5)[-6], ceiling(max(x$z)) + 1)))
ggplot(x, aes(x = x, y = y, color = z, shape = z == 0, size = z)) +
geom_point(stroke = 1.5) +
scale_shape_manual(values = c(`TRUE` = 3, `FALSE` = 21), guide = "none") +
scale_size(range = c(1, 8),
breaks = color_breaks,
limits = c(-1, ceiling(max(x$z)) + 2)
) +
binned_scale(aesthetics = "color",
scale_name = "stepsn",
palette = function(x) c("red", viridis::viridis(length(color_breaks) - 1)),
limits = c(-1, ceiling(max(x$z)) + 2),
breaks = color_breaks,
show.limits = FALSE
) +
guides(color = guide_legend(),
size = guide_legend(override.aes = list(shape = c(3, rep(16, 5))))) +
theme_bw()
I am trying to use the KMggplot2 plugin for Rcmdr. It only seems to work with the built it data set dataKm. When I try to use other data sets such as lung, I get no plot - just the error message "numbers of columns of arguments do not match. Here is the code for each plot attempt.
Here is the code when I try using the lung data even without attempting to have a number at risk list.
library(survival, pos=17)
data(lung, package="survival")
sapply(c("ggplot2", "grid"), require, character.only = TRUE)
Loading required package: ggplot2
Loading required package: grid
ggplot2 grid
TRUE TRUE
.df <- data.frame(x = lung$time, y = lung$status, z = factor("At risk"))
.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)
.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 <- unique(.df)
.df <- .fit <- data.frame(.fit, .df[, c("z"), drop = FALSE])
Error in data.frame(.fit, .df[, c("z"), drop = FALSE]) : arguments imply differing number of rows: 186, 199
.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)
Error in rbind(deparse.level, ...) : numbers of columns of arguments do not match
.cens <- subset(.fit, ncensor == 1)
.plot <- ggplot(data = .fit, aes(x = x, y = y, colour = z)) + geom_step(data = subset(.fit, !is.na(upper)), aes(y = upper), size = 1, lty = 2, alpha = 0.5, show_guide = FALSE, na.rm = FALSE) +
geom_step(data = subset(.fit, !is.na(lower)), + aes(y = lower), size = 1, lty = 2, alpha = 0.5, show_guide = FALSE, na.rm = FALSE) +
geom_step(size =1.5)+ geom_linerange(data = .cens, aes(x = x, ymin = y, ymax = y + 0.02), size = 1.5) +
scale_x_continuous(breaks = seq(0, 900, by = 300), limits = c(0, 900)) + scale_y_continuous(limits = c(0, 1), expand = c(0.01, 0)) +
scale_colour_brewer(palette = "Set1") + xlab("Time from entry") +
ylab("Proportion of survival") +
theme_gray(base_size = 14, base_family = "serif")
Error in +geom_step(size = 1.5) : invalid argument to unary operator+
theme(legend.position = "none")
Error in inherits(x, "theme") : argument "e2" is missing, with no default
print(.plot)
Error in eval(expr, envir, enclos) : object 'z' not found
I just received this response from the developer who said that an update would be uploaded by the end of the month:
"We found a bug was caused by a tie data handling.The following code can be used."
sapply(c("ggplot2", "grid"), require, character.only = TRUE)
.df <- data.frame(x = lung$time, y = lung$status, z = factor("At risk"))
.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)
.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$x), ]
.df <- .fit <- data.frame(.fit, .df[, c("z"), drop = FALSE])
.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) .plot <- ggplot(data = .fit, aes(x = x, y = y, colour = z)) +
geom_step(data = subset(.fit, !is.na(upper)), aes(y = upper), size = 1, lty = 2, alpha = 0.5, show_guide = FALSE, na.rm = FALSE) +
geom_step(data = subset(.fit, !is.na(lower)), aes(y = lower), size = 1, lty = 2, alpha = 0.5, show_guide = FALSE, na.rm = FALSE) +
geom_step(size = 1.5) +
geom_linerange(data = .cens, aes(x = x, ymin = y, ymax = y + 0.02), size = 1.5) +
scale_x_continuous(breaks = seq(0, 900, by = 300), limits = c(0, 900)) +
scale_y_continuous(limits = c(0, 1), expand = c(0.01, 0)) +
scale_colour_brewer(palette = "Set1") +
xlab("Time from entry") +
ylab("Proportion of survival") +
theme_gray(base_size = 14, base_family = "serif") +
theme(legend.position = "none")
print(.plot)