How to get rid of points in legends with ggnewscale? - r

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))

Related

Can individual legend have different 'element.key' theme in ggplot?

I have multiple legends in ggplot and want to control the legend.key for different legends. Is there a way to do this?
library(tidyverse)
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")
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") +
theme(legend.key = element_rect(fill = "pink",colour = "darkblue"))

How to add a custom legend to multiple geom_function()?

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))))

scales_fill_continuous doesn't work (ggplot2)

I have a data:
df_1 <- data.frame(
x = replicate(
n = 2, expr = rnorm(n = 3000, mean = 100, sd = 10)
),
y = sample(x = 1:3, size = 3000, replace = TRUE)
)
And the follow function:
library(tidyverse)
ggplot(data = df_1, mapping = aes(x = x.1, fill = x.1)) +
geom_histogram(color = 'black', bins = 100) +
scale_fill_continuous(low = 'blue', high = 'red') +
theme_dark()
scale_fill_continuous doesn't work. The graph is black and gray.
Tks.
The problem, I think, is that there are nrow(df_1) values for fill, but only 100 are needed. This could be solved by pre-calculating the bin positions and counts and plotting with geom_col, but a neater solution is to use stat. stat is supposed to be for computed variables (e.g. stat(count) - see ?geom_histogram) but we can give it the vector 1:nbin and it works.
df_1 <- data.frame(
x = replicate(n = 2, expr = rnorm(n = 3000, mean = 100, sd = 10)),
y = sample(x = 1:3, size = 3000, replace = TRUE)
)
library(tidyverse)
nbins <- 100
ggplot(data = df_1, mapping = aes(x = x.1, fill = stat(1:nbins))) +
geom_histogram(bins = nbins) +
scale_fill_continuous(low = "red", high = "blue")
Created on 2020-01-19 by the reprex package (v0.3.0)
The aes fill should be stat(count) rather than x.1
ggplot(data = df_1, mapping = aes(x = x.1, fill = stat(count))) +
geom_histogram(color = 'black', bins = 100) +
scale_fill_continuous(type = "gradient", low = "blue", high = "red") +
theme_dark()

Sunburst plot - Error in generating more than 2 rings

I have got this data set and want to generate a sunburst plot. The data is of 4 columns which are unit, weight, year16 and year17. The sunburst is based on the values in the weight column. The code is there and when adding the coding for the third layer it is giving me an error. I think the error is coming when I am adding the third layer.
library("ggnewscale")
library(ggplot2)
#read file
weight.eg = read.csv("Dummy Data.csv", header = FALSE, sep =
";",encoding = "UTF-8")
#change column names
colnames(weight.eg) <- c
("unit","weight","year16","year17")
#check the class
sapply(weight.eg, class)
#View(weight.eg)
#as weight column is factor change into integer
weight.eg$weight = as.numeric(levels(weight.eg$weight))
[as.integer(weight.eg$weight)]
weight.eg$year16 = as.numeric(levels(weight.eg$year16))
[as.integer(weight.eg$year16)]
weight.eg$year17 = as.numeric(levels(weight.eg$year17))
[as.integer(weight.eg$year17)]
#Nas are introduced, remove
weight.eg <- na.omit(weight.eg)
#Sum of the total weight
sum_total_weight = sum(weight.eg$weight)
#First layer
firstLevel = weight.eg %>% summarize(total_weight=sum(weight))
cs_fun <- function(x){(cumsum(x) + c(0, cumsum(head(x , -1))))/ 2}
ggplot(weight.eg) +
geom_col(data = firstLevel,
aes(x = 1, y = total_weight)) +
geom_text(data = firstLevel,
aes(x = 1, y = total_weight / 2,
label = paste("Total Weight:", total_weight)),
colour = "black") +
geom_col(aes(x = 2,
y = weight, fill = weight),
colour = "black", size = 0.6) +
scale_fill_gradient(name = "Weight",
low = "white", high = "lightblue") +
# Open up new fill scale for next ring
new_scale_fill() +
geom_text(aes(x = 2, y = cs_fun(weight),
label = paste(unit, weight))) +
geom_col(aes(x = 3, y = weight, fill = year16),
size = 0.6, colour = "black") +
scale_fill_gradient(name = "Year16",
low = "red", high = "green") +
geom_text(aes(label = paste0(unit,year16), x = 3,
y = cs_fun(weight))) +
#next ring
new_scale_fill() +
geom_text(aes(x = 2, y = cs_fun(weight),
label = paste(unit, weight))) +
geom_col(aes(x = 4, y = weight, fill = year17),
size = 0.6, colour = "black") +
scale_fill_gradient(name = "Year17",
low = "red", high = "green") +
geom_text(aes(label = paste0(unit,year17), x = 4,
y = cs_fun(weight))) +
coord_polar(theta = "y")
The output for dput(weight.eg) is
structure(list(unit = structure(1:6, .Label = c("A", "B", "C",
"D", "E", "F", "Unit"), class = "factor"), weight = c(30, 25,
10, 17, 5, 13), year16 = c(70, 80, 50, 30, 60, 40), year17 = c(50,
100, 20, 30, 70, 60)), .Names = c("unit", "weight", "year16",
"year17"), row.names = 2:7, class = "data.frame", na.action =
structure(1L, .Names = "1", class = "omit"))
I want to include year17 as well and in the future there will be
columns, so that has to be added as well. Because of the error I
am not able to figure out what is wrong.

KMggplot2 plugin only seems to work with package example

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)

Resources