Changing R legend label when using get - r

Suppose you have data:
df = data.frame(A = rep(1:10,each=10),B = rep(1:10,times=10),C = runif(100,0,1))
I've written a function that takes a column name as an argument:
plotFill<-function(dataframe,variable){
if(!(variable %in% names(dataframe))) stop("Variable not in data.frame")
plot = ggplot(data=dataframe,aes(x=A,y=B,z=get(variable))) +
geom_tile(aes(fill=get(variable)))
return(plot)
}
You can therefore run this doing: plotFill(df,"C")
I'm trying to label the legend with the name of the variable passed, but adding labs(colour=variable) doesn't work, which I think it should since variable is a string...

If its only about the label name, you could use plot$labels$fill:
plotFill<-function(dataframe,variable){
if(!(variable %in% names(dataframe))) stop("Variable not in data.frame")
plot = ggplot(data=dataframe,aes(x=A,y=B,z=get(variable))) +
geom_tile(aes(fill=get(variable)))
plot$labels$fill <- variable
return(plot)
}

You shouldn't use get here. Instead, use aes_string.
plotFill<-function(dataframe,variable){
if(!(variable %in% names(dataframe))) stop("Variable not in data.frame")
plot = ggplot(data=dataframe,aes_string(x="A",y="B",z=variable)) +
geom_tile(aes_string(fill=variable))
return(plot)
}
plotFill(df,"C")

Related

How do I create a function that returns the histogram of a given data frame?

I need to create a function called histagram, the function receives 3 arguments: data frame, column name, and color number.
if all the arguments meet the criteria (valid data frame, color number an integer, and column name input must be character and the column must be of type numeric, the function returns a plot of histogram of the chosen column with the chosen color.
Also we need to change the "x - axis" so it will represent the column name input.
my script:
histagram = function(dataframe, columnName, colorNumber) {
if (!is.data.frame(dataframe)){
print("Please enter a Data frame structure")
} else if(!is.integer(as.integer(colorNumber))){
print("Enter a char columne name")
} else if(!is.character(columnName)){
print("Color must be a integer")
} else {
return(hist(dataframe$as.numeric(columnName), xlab = "columnName", col = as.integer(colorNumber)))
}
}
I tested the function to see if it worked:
histagram(dataframe = airdf, colorNumber = 7, columnName = "Temp")
I used the airquality data frame, which is a built-in data frame in R. airdf = airquality.
I'm getting an error message -
Error in dataframe$as.numeric(columnName) : attempt to apply non-function
Called from: hist(dataframe$as.numeric(columnName), xlab = "columnName", col = as.integer(colorNumber))
What needs to be changed in my code for it to work?
Many thanks!
In addition to Martin Gal's comment, you should also remove the quotations around columnName under the xlab argument and consider adding something to the histogram title. If you don't specify the histogram title, it just says "Histogram of as.numeric(dataframe[, columnName])", which is a bit clunky.
data(airquality)
airdf <- airquality
histagram <- function(dataframe, columnName, colorNumber) {
if (!is.data.frame(dataframe)){
print("Please enter a Data frame structure")
} else if(!is.integer(as.integer(colorNumber))){
print("Enter a char columne name")
} else if(!is.character(columnName)){
print("Color must be a integer")
} else {
return(hist(as.numeric(dataframe[, columnName]), # <- from Martin Gal
main = paste("Histogram of", columnName), # <- dynamic title
xlab = columnName, # <- remove quotes here
col = as.integer(colorNumber)))
}
}
histagram(dataframe = airdf, colorNumber = 7, columnName = "Temp")

In R, how do I get an if statement to recognize if input in double curly brackets is a certain value?

I'm building a function where users can select a column from a list of options, and within the function, I want to do an if statement where, if the x variable is one of the options that the function is designed to work with, it will generate the plot. Otherwise, it will print an error message.
However, when I try to do if({{x_variable}} == ses)--the correct variable in this example--I keep getting
Error in make_plot(test_data, x_variable = ses) : object 'ses' not found
That's the same error I get for if(enquo(x_variable) == ses) and if(!!x_variable == ses)
The correct answer will produce the plot when x_variable is ses and will print the error when x_variable is anything else.
Here's a sample dataset and my function (that does not work collectively, but each individual part does):
library(dplyr)
library(rlang) #if enquo() is needed
test_data <- tibble(ses = c(rep(c("High", "Mid", "Mid Low", "Low"), 2)),
total = c(10, 20, 20, 30, 9, 11, 40, 60))
make_plot <- function(data, x_variable) {
if({{x_variable}} == "ses") {
ggplot(data = test_data, aes(x = {{x_variable}}, y = total)) +
geom_col()
} else {
print("This function isn't designed for this variable, sorry!")
}
}
make_plot(test_data, x_variable = ses)
make_plot(test_data, x_variable = anything_else)
You have to use:
make_plot(test_data, x_variable = "ses")
or alternatively:
ses <- "ses"
make_plot(test_data, x_variable = ses)
This error means that the object ses is not declared.
If you want to be able to pass undeclared objects such as ses as an input, you could use substitute(x_variable) or deparse(substitute(x_variable))
make_plot <- function(data, x_variable) {
#print(deparse(substitute(x_variable)))
if(deparse(substitute(x_variable)) == "ses") {
ggplot(data = test_data, aes(x = ses, y = total)) +
geom_col()
} else {
print("This function isn't designed for this variable, sorry!")
}
}
This is non-standard evaluation however, so make sure this is indeed what you're after as it can lead to surprising behaviours.
This explains the difference between both options, from Advanced R
To supplement #gaut's elaborate answer, or if it's easier for you to remember (or understand how {{ work), you would need the following to use the curly brackets.
names(select(data, {{x_variable}})) == "ses"

Variable name to strings, R

I have a question about convert variable name into strings to work as a x-axis name.
I tried to apply the deparse(substitute(input)), but unfortunately, it doesn't work well when I called this function within another function.
plot_CI <- function(input){
nm <- deparse(substitute(input))
if (substring(nm,1,1) == 'u') {
prior <- 'uniform'
} else if ((substring(nm,1,1) == 'l')) {
prior <- 'logit_Normal'
} else {
prior <- paste(strsplit(nm,"_")[[1]][1:2],collapse="_")
}
plot <- ggplot(temp_data, aes(x = x, y = mean)) +
geom_point(size = 2) +
geom_errorbar(aes(ymax = high, ymin = low)) +
geom_hline(yintercept = true_value, col = 'blue') +
labs(x=prior, y='value')
return(plot)
}
sen_plot <- function(variable){
# variable <- deparse(substitute(var))
file_name <- paste0('C:/Users/Qiangsuper/Dropbox/Papers/1/plot/sensitivity_', variable, '.png')
png(filename = file_name, width = 1000, height = 400)
p1 <- plot_CI(eval(parse(text = paste0('uniform_', variable))))
p2 <- plot_CI(eval(parse(text = paste0('logitN_', variable))))
multiplot(p1,p2,cols=2)
dev.off()
}
for (i in c("beta_1", "beta_2", "beta_3", "phi", "p", "delta")) {
sen_plot(i)
}
I expect 'uniform' as X-axis name, however, I only received eval(parse(text = paste0('Uniform_', variable))).
Thank you very much for your help.
UPDATE ABOUT QUESTION:
I think I should make the question more concise. Here is an easily-understood scenario.
uniform_beta_1 is a data frame or data table, which stores the my results. I try to develop an automatic plotting algorithm which will automatically identify which prior distribution I applied and name the X-axis with this prior distribution. For uniform_beta_1, the prior distribution is uniform, then the X-axis's name will be uniform. Here is what I try to do:
input <- uniform_beta_1
nm <- deparse(substitute(input))
Then apply the substring command to judge the prior distribution. However, in this case, nm will return 'input' rather than 'uniform_beta_1'. I am wondering if there is any way I can return 'uniform_beta_1'.
Thank you very much for your help.
The final solution for my question is that I create a list at very beginning and store all these strings into this list to avoid the transformation in the function.

Feed empty argument if a condition is met in R

I am writing a function that feeds an extra argument to a function if certain condition is met otherwise leave that argument as empty.
The code below is an example that plots "Sepal.Length" and if fn_y is not NULL then the color argument will be feed into the function as well (i.e. split the scatter plot according to fn_y ).
fn_plotly <- function(fn_data, fn_x, fn_y){
if(is.null(fn_y)){
p <- plotly::plot_ly(data = fn_data, x = ~fn_data[[fn_x]],
type = "scatter")
} else {
p <- plotly::plot_ly(data = fn_data, x =~ fn_data[[fn_x]],
type = "scatter", color = fn_data[[fn_y]])
}
return(p)
}
fn_plotly(iris, "Sepal.Length", NULL)
fn_plotly(iris, "Sepal.Length", "Species")
The code above does work but I was wondering if there is any other way that could use pipe function %>% to write the code a bit shorter, i.e. something like this
plotly::plot_ly(data = fn_data, x =~ fn_data[[fn_x]],type="scatter") %>% ifelse(is.null(fn_y),"",color = fn_data[[fn_y]] )
I would like to use this functionality not only on plotly so please do not suggest me to use other plotting packages.
Are you aware that you can get the same result without any if then else?
See this:
fn_plotly<-function(fn_data,fn_x,fn_y){
p<-plotly::plot_ly(data = fn_data, x =~ fn_data[[fn_x]],type="scatter", color=fn_data[,fn_y])
return(p)
}
fn_plotly(iris,"Sepal.Length",NULL)
fn_plotly(iris,"Sepal.Length","Species")

R Greek letters and normal letters for facet label in R facet grid

I would like to change the facet labels, such that I have greek letters on the y axis and normal text on the x axis. The testing data is:
testdata<-data.frame(Method2=c("a","a","b","b"),
gamma=c(0,1,0,1),values=c(1,2,3,4),x=rep(1,4),y=rep(1,4))
testplot2<-ggplot(data=testdata,aes(x=Method2,y=gamma))
testplot2<-testplot2+facet_grid(gamma~Method2 )
testplot2+geom_point()
So far I have tried the following in many differnt constellations and I'm getting rather desperate:
1) To change the names in the data frame with the paste expression and I used label_parsed without much success.
gamma<- factor(sapply(testdata$gamma, function(n){
if(n %in% c("0")) paste(expression(gamma),"0") else
if(n %in% c("1")) paste(expression(gamma),"1")
}), levels=c(paste(expression(gamma),"0"),
paste(expression(gamma),"1")
))
testdata$gamma <- gamma
2) And I have tried to use a labeller with
my.label_bquote <- function (expr1 = (gamma == .(x)),expr2 = x)
{
quoted1<- substitute(expr1)
function(variable, value) {
value <- as.character(value)
browser()
if(variable == gamma)
lapply(value, function(x) eval(substitute(bquote(expr1, list(x = x)),list(expr1 = quoted1))))
else if(variable == Method2){
value[value=="a"] <- "Whatever"
value[value=="b"] <- "Whatever2"
}
return(value)
}
}
which is a changed form of a previous answer given to a similar question:
Facet labels involving a greek symbol
Would be grateful for any help!
How about we create a label swapper factory of sorts. Here's a generic function that will allow for renaming of levels of values in facet labels
get_label_swap <- function(...) {
dots<-list(...)
function(variable, value) {
if(variable %in% names(dots)) {
swaps <- dots[[variable]]
vals <- as.character(value)
lapply(vals, function(v) {if(v %in% names(swaps)) swaps[[v]] else v })
} else {
label_value(variable, value)
}
}
}
Then, to get one specific to your problem, we would do
label_swap <- get_label_swap(gamma=list("0"=expression(gamma*0),
"1"=expression(gamma*1)))
So the function looks at the named parameters and expects a list where the names of the list are the values of the factor, and the values in the list are what you want to replace them with. So only for the variable "gamma" will it swap "0" and "1" with the appropriate expressions. Then it returns a function we can pass as a labeller= parameter to ggplot. Thus we plot with
testplot2 <- ggplot(data=testdata,aes(x=Method2,y=gamma))
testplot2 <- testplot2+facet_grid(gamma~Method2, labeller=label_swap)
testplot2 + geom_point()
which results in
The newest version of ggplot no longer supports these types of labellers, here's a possible alternative solution using the new labeller_bquote function
ggplot(data=testdata,aes(x=Method2,y=gamma)) +
geom_point() +
facet_grid(gamma~Method2, labeller=label_bquote(rows=gamma*.(gamma)))

Resources