Customize facet_wrap plot label in R? - r

I'm creating a facet_wrap plot in R, and I'm trying to automate the labeller. I can create a custom label manually, using this code:
library(ggplot2)
library(tidyverse)
df <- data.frame(a = rep(c(1/8,1/4,1/2), each = 100),
b = rep(c("A", "B", "C", "D"), each = 25),
x = rnorm(100))
names <- c(
`0.125` = "alpha~`=`~1/8",
`0.25` = "alpha~`=`~1/4",
`0.5` = "alpha~`=`~1/2"
)
df %>% ggplot() +
geom_density(aes(x = x, colour = b))+
facet_wrap(~a, labeller = labeller(a = as_labeller(names, label_parsed)))
The above code produces this plot:
facetplot
As you can see I'm creating the custom names in the names variable and then passing that to the labeller argument. I want to come up with a way to automate this process. So I can use any vector of names. Any suggestions?

I think I have a possible solution. If a user supplies a personalised vector of values, say, vec <- c(1/5, 'Hello', 3.14) then Im looping through each value of vector and pasting the unicode value for alpha and turning it into a list. After this I am creating a kind of dummy function that contains my new list of label titles and Im passing that to the labeller function:
# EDIT: removed loop with help from comments!
#nam <- NULL
# for(i in 1:(length(vec))){
# nam[i] <- list(paste0('\u03b1',"=", vec[i]))
#}
nam <- paste0('\u03b1',"=", vec)
custLab <- function (x){
nam
}
p <- df %>% ggplot() +
geom_density(aes(x = x, colour = b))+
facet_wrap(~a, labeller = as_labeller((custLab)))
This produces the following:

Related

Convert an vector to a specific color for `plot()`

Below is a minimal working example.
library(ggplot2)
set.seed(926)
df <- data.frame(x. = rnorm(100),
y. = rnorm(100),
color. = rnorm(100))
library(ggplot2)
p <- ggplot(df, aes(x = x., y = y., color = color.)) +
geom_point() +
viridis::scale_color_viridis(option = "C")
p
p_build <- ggplot_build(p)
# The desired vector is below somehow I feel there must have an easier way to get it
p_build[["data"]][[1]][["colour"]]
df$color_converted <- p_build[["data"]][[1]][["colour"]]
Specifically, I like to use viridis::viridis(option = "C") color scheme. Could anyone help with this? Thanks.
*Modify*
Sorry, my question wasn't clear enough. Let me put it this way, I couldn't utilize ggplot2 package and had to use the pure plot() function that comes with R, in my specific project.
My goal is to try to reproduce the above plot with the base R package.
plot(df$x., df$y., color = df$color_converted)
If possible, could anyone also direct me on how to customize a gradient legend that is similar to ggplot2, with base legend()?
First of all you can assign the colors to a vector called "color2" and use scale_colour_gradientn to assign these colors to your plot. The problem is that the colors are not sorted right so you have to do that first by using the TSP package. In the output below you can see that you can recreate the plot without using scale_color_viridis:
set.seed(926)
df <- data.frame(x. = rnorm(100),
y. = rnorm(100),
color. = rnorm(100))
library(ggplot2)
library(TSP)
p <- ggplot(df, aes(x = x., y = y., color = color.)) +
geom_point() +
viridis::scale_color_viridis(option = "C")
p
p_build <- ggplot_build(p)
# The desired vector is below somehow I feel there must have an easier way to get it
color2 <- p_build[["data"]][[1]][["colour"]]
rgb <- col2rgb(color2)
lab <- convertColor(t(rgb), 'sRGB', 'Lab')
ordered_cols2 <- color2[order(lab[, 'L'])]
ggplot(df, aes(x = x., y = y.)) +
geom_point(aes(colour = color.)) +
scale_colour_gradientn(colours = ordered_cols2, guide = "colourbar")
#viridis::scale_color_viridis(option = "C")
Created on 2022-08-17 with reprex v2.0.2
Base r
You can use the following code:
color2 <- p_build[["data"]][[1]][["colour"]]
rgb <- col2rgb(color2)
lab <- convertColor(t(rgb), 'sRGB', 'Lab')
ordered_cols2 <- color2[order(lab[, 'L'])]
layout(matrix(1:2,ncol=2), width = c(2,1),height = c(1,1))
plot(df$x., df$y., col = df$color_converted)
legend_image <- as.raster(matrix(ordered_cols2, ncol=1))
plot(c(0,2),c(0,1),type = 'n', axes = F,xlab = '', ylab = '', main = 'legend title')
text(x=1.5, y = seq(0,1,l=5), labels = seq(-3,3,l=5))
rasterImage(legend_image, 0, 0, 1,1)
Output:

Saving ggplot2 output in R to pdf file when using dplyr and mapply function

I'm still learning R (clearly), and cannot figure out where my problem might be when trying to save ggplot2 output into a pdf file. I have been able to create code using a loop to save ggplot output, but want to force myself to avoid loops and take advantage of R's ability to do so.
I have looked at other posts regarding saving pdf files, but none seemed to address my issue.
Here is a reproducible example:
# Create example data frame for reproducible example
amount <- c(rep(5, 25), rep(10, 50), rep(15, 25))
value <- c(rep(100, 20), rep(200, 30), rep(300, 50))
fund <- I(c(rep("FundA", 50), rep("FundB", 50)))
example_df <- data.frame(amount, value, fund)
#==============================================================
# Weighted histogram function for plotting
histogram_wt_fx <- function(my_df, xvar, my_weight,
chart_title = "title",
chart_xlabel = "x",
chart_ylabel = "y") {
library(ggplot2)
histogram <- ggplot(my_df, aes(x = xvar, weight = my_weight)) +
geom_histogram(binwidth=0.25, colour="black", fill="white")
# add another layer showing weighted avg amount
histogram <- histogram + geom_vline(aes(xintercept = sum (xvar*my_weight)),
color="red", linetype="dashed", size=1) +
labs(title = chart_title , x = chart_xlabel, y = chart_ylabel)
}
#===============================================================
# Function to weight data and plot histogram
# Note: fund_wtd_fx in turn calls histogram_wt_fx
fund_wtd_fx <- function(my_df, my_title) {
my_df <- my_df %>%
mutate(pct_amount = amount/sum(amount))
my_df %>%
histogram_wt_fx (xvar = my_df$value,
my_weight = my_df$pct_amount,
chart_title = my_title,
chart_xlabel = "Amount",
chart_ylabel = "Percent") %>%
plot() #%>%
#*** This is where the problem code is ****
#pdf() %>%
#plot()
}
#=====================================
# Extract fund lists from larger data set and run the functions on this list
fund_names <- unique(example_df$fund) # List of funds in the data frame
fund_dfs <- list() # Initialize list of data frames
# Create list of fund data frames
for (myfund in fund_names) {
myfund <- example_df %>%
filter(fund == myfund)
fund_dfs[[length(fund_dfs)+1]] <- myfund
}
rm(myfund)
names(fund_dfs) <- fund_names
# Assign list of fund names to the list of data frames
for (i in 1:length(fund_names)) {
assign(fund_names[[i]], fund_dfs[[i]])
}
# Run histogram function on each fund
my_title <- as.list(paste0("Some title for ", (names(fund_dfs))))
mapply(FUN = fund_wtd_fx, fund_dfs, my_title)
#dev.off()
My problem:
This code runs like I want it to, but if you uncomment lines 39, 41, 42, and 68 (assuming you pasted the code starting in line 1), then the plots do not get saved and a plot.window error is thrown.
I would have thought that pipe operator on uncommented line 39, would feed into the pdf function to save the plot output as the mapply function cycles through the data frames. Ultimately that is what I am trying to do--save the plots generated into a pdf file with this code.
Many thanks for any help or suggestions.
histogram_wt_fx() now returns the plot object to fund_wtd_fx() which now also returns the plot object.
Switched to purrr::map2() from mapply and did the plotting at the end.
Take a look, give it a go and let me know if I can/should explain a bit more.
library(dplyr)
library(ggplot2)
library(purrr)
amount <- c(rep(5, 25), rep(10, 50), rep(15, 25))
value <- c(rep(100, 20), rep(200, 30), rep(300, 50))
fund <- I(c(rep("FundA", 50), rep("FundB", 50)))
example_df <- data.frame(amount, value, fund)
histogram_wt_fx <- function(my_df, xvar, my_weight,
chart_title = "title",
chart_xlabel = "x",
chart_ylabel = "y") {
histogram <- ggplot(my_df, aes(x = xvar, weight = my_weight)) +
geom_histogram(binwidth=0.25, colour="black", fill="white")
histogram <- histogram + geom_vline(aes(xintercept = sum (xvar*my_weight)),
color="red", linetype="dashed", size=1) +
labs(title = chart_title , x = chart_xlabel, y = chart_ylabel)
histogram
}
fund_wtd_fx <- function(my_df, my_title) {
my_df <- my_df %>%
mutate(pct_amount = amount/sum(amount))
my_df %>%
histogram_wt_fx(xvar = my_df$value,
my_weight = my_df$pct_amount,
chart_title = my_title,
chart_xlabel = "Amount",
chart_ylabel = "Percent")
}
fund_names <- unique(example_df$fund) # List of funds in the data frame
fund_dfs <- list() # Initialize list of data frames
for (myfund in fund_names) {
myfund <- example_df %>%
filter(fund == myfund)
fund_dfs[[length(fund_dfs)+1]] <- myfund
}
rm(myfund)
names(fund_dfs) <- fund_names
for (i in 1:length(fund_names)) {
assign(fund_names[[i]], fund_dfs[[i]])
}
my_title <- as.list(paste0("Some title for ", (names(fund_dfs))))
plots <- map2(fund_dfs, my_title, fund_wtd_fx)
pdf()
walk(plots, print)
dev.off()

R ggplot2 using variable expressions in legend name

I am trying to plot a series of time series with ggplot2 that sometimes have greek names. As the plot uses dynamic names (i.e. the names of the variables are stored within another variable) I am having troubles to get it to work.
Here is an example:
# create some data
df <- data.frame(time = rep(1:10, 3),
variable = rep(letters[1:3], each = 10),
val = rnorm(30))
# create a variable for the group name
nam <- expression("alpha[i]")
library(ggplot2)
# plot the data as a line
ggplot(df, aes(x = time, y = val, color = variable)) +
geom_line() +
# Option 1: Does not work
scale_color_discrete(name = eval(nam))
# Option 2: works but has no variable input
# scale_color_discrete(name = expression(alpha[i]))
Do you have any idea of how I can evaluate the variable nam to be displayed as the name of the legend as in option 2?
Thank you very much!
Using this code
# create some data
df <- data.frame(time = rep(1:10, 3),
variable = rep(letters[1:3], each = 10),
val = rnorm(30))
# create a variable for the group name
nam <- expression(alpha[i])
library(ggplot2)
# plot the data as a line
ggplot(df, aes(x = time, y = val, color = variable)) +
geom_line() +
# Option 1: Does not work
scale_color_discrete(name = nam)
# Option 2: works but has no variable input
# scale_color_discrete(name = expression(alpha[i]))
This gives me the plot you probably wanna see. No eval in name = eval(name) and no blockquotes in the assignment nam <- expression(alpha[i])
Probably this will work:
nam <- "alpha[i]"
...
scale_color_discrete(name = eval(parse(text= nam)))

ggplot in a function: variable not found

I have an issue trying to create a function to creat a plot using ggplot. Here is some code:
y1<- sample(1:30,45,replace = T)
x1 <- rep(rep(c("a1","a2","a3","a4","a5"),3),each=3)
x2 <- rep(rep(c("b1","b2","b3","b4","b5"),3),each=3)
df <- data.frame(y1,x1,x2)
library(Rmisc)
dfsum <- summarySE(data=df, measurevar="y1",groupvars=c("x1","x2"))
myplot <- function(d,v, w,g) {
pd <- position_dodge(.1)
localenv <- environment()
ggplot(data=d, aes(x=v,y=w,group=g),environment = localenv) +
geom_errorbar(data=d,aes(ymin=d$w-d$se, ymax=d$w+d$se,col=d$g), width=.4, position=pd,environment = localenv) +
geom_line(position=pd,linetype="dotted") +
geom_point(data=d,position=pd,aes(col=g))
}
myplot(dfsum,x1,y1,x2)
As I was looking for similar questions, I found that specifying the local environment should solve the issue. However it did not help in my case.
Thank you
Preliminary Note
When looking at your data.frame, the group variable does not make any sense, as it is perfectly confounded with the x variable. Hence I adapted your data a bit, to show a full example:
Data
library(Rmisc)
library(ggplot2)
d <- expand.grid(x1 = paste0("a", 1:5),
x2 = paste0("b", 1:5))
d <- d[rep(1:NROW(d), each = 3), ]
d$y1 <- rnorm(NROW(d))
dfsum <- summarySE(d, measurevar = "y1", groupvars = paste0("x", 1:2))
Plot Function
myplot <- function(mydat, xvar, yvar, grpvar) {
mydat$ymin <- mydat[[yvar]] - mydat$se
mydat$ymax <- mydat[[yvar]] + mydat$se
pd <- position_dodge(width = .5)
ggplot(mydat, aes_string(x = xvar, y = yvar, group = grpvar,
ymin = "ymin", ymax = "ymax", color = grpvar)) +
geom_errorbar(width = .4, position = pd) +
geom_point(position = pd) +
geom_line(position = pd, linetype = "dashed")
}
myplot(dfsum, "x1", "y1", "x2")
Explanation
Your problem occurs because the scope of x1 x2 and y1 was ambiguous. As you defined these variables also at the top environmnet, R did not complain in the first place. If you had added a rm(x1, x2, y1)in your original code right after you created your data.frame you would have seen the problem already eralier.
ggplot looks in the data.frame you provide for all the variables you want to map to certain aesthetics. If you want to create a function, where you specify the name of the aesthatics as arguments, you should use aes_string instead of aes, as the former expects a string giving the name of the variable rather than the variable itself.
With this approach however, you cannot do calculations on the spot, so you need to create the variables yminand ymaxbeforehand in your data.frame. Furthermore, you do not need to provide the data argument for each geom if it is the same as provided to ggplot.
I've got it plotting something, let me know if this isn't the expected output.
The changes I've made to the code to get it working are:
Load the ggplot2 library
Remove the d$ from the geom_errorbar call to w and g, as these are function arguments rather than columns in d.
I've also removed the data=d calls from all layers except the main ggplot one as these aren't necessary.
library(ggplot2)
myplot <- function(d,v, w,g) {
pd <- position_dodge(.1)
localenv <- environment()
ggplot(data=d, aes(x=v,y=w,group=g),environment = localenv) +
geom_errorbar(aes(ymin=w-se, ymax=w+se,col=g), width=.4,
position=pd,environment = localenv) +
geom_line(position=pd,linetype="dotted") +
geom_point(position=pd,aes(col=g))
}
myplot(dfsum,x1,y1,x2)

how to save ggplots as separate R-objects using For loop

It is intended to produce a number of plots and then merge them freely together using multiplot function. Please could you tell me how to save each plot as a separate R-object instead of having it printed as png file:
Examplary dataframe:
df1 <- data.frame(A = rnorm(50), B = rnorm(50), C = rnorm(50), group = rep(LETTERS[24:25], 25))
we use a for loop to produce pictures and save them in a file:
And the loop to change:
for(i in names(df1)[1:3]) {
png(paste(i, "png", sep = "."), width = 800, height = 600)
df2 <- df1[, c(i, "group")]
print(ggplot(df2) + geom_boxplot(aes_string(x = "group", y = i, fill = "group")) + theme_bw())
dev.off()
}
Could you please help with changing the code in order to save each plot as R-object on my screen?
Big Thanks in advance!
I'm not sure what you are talking about with "merge them freely together using multiplot function", but you can save ggplot objects using the standard assignment operator. Like any R object, they can be stored in a list.
# empty list for storage
gg_list <- list()
# if you must use a loop, loop through an indexing vector
for(i in 1:3) {
# if you need the i'th name in df1 use:
names(df1)[i]
# assign your ggplot call to the i'th position in the list
gg_list[[i]] <- ggplot(...)
}
# Now you can recall the ggplots by reference to the list.
# E.g., display the 1st one:
print(gg_list[[1]])
Instead of using a for loop, if you're gonna store in a list you could just use lapply:
df1 <- data.frame(A = rnorm(50),
B = rnorm(50),
C = rnorm(50),
group = rep(LETTERS[24:25], 25))
gg_list <- lapply(names(df1)[1:3], function(i) {
df2 <- df1[, c(i, "group")]
ggplot(df2) +
geom_boxplot(aes_string(x = "group", y = i, fill = "group")) +
theme_bw()
})
gg_list[[1]]
You can even save the list in an RDS object:
saveRDS(gg_list, file = "./gg_list.RDS")
Here's an alternative strategy that I find more straight-forward (no need to fiddle with names and aes_string): melt the data to long format, and plot subsets
df1 <- data.frame(A = rnorm(50), B = rnorm(50), C = rnorm(50),
group = rep(LETTERS[24:25], 25))
m = reshape2::melt(df1, id="group")
## base plot, all the data
p = ggplot(m) + geom_boxplot(aes(x = group, y = value)) + theme_bw()
## split-and-apply strategy, using the `%+%` operator to change datasets
pl = plyr::dlply(m, "variable", `%+%`, e1 = p)
do.call(gridExtra::grid.arrange, pl)

Resources