Question: why can't I call sapply inside aes()?
Goal of following figure: Create histogram showing proportion that died/lived so that the proportion for each combination of group/type sums to 1 (example inspired by previous post).
I know you could make the figure by summarising outside of ggplot but the question is really about why the function isn't working inside of aes.
## Data
set.seed(999)
dat <- data.frame(group=factor(rep(1:2, 25)),
type=factor(sample(1:2, 50, rep=T)),
died=factor(sample(0:1, 50, rep=T)))
## Setup the figure
p <- ggplot(dat, aes(x=died, group=interaction(group, type), fill=group, alpha=type)) +
theme_bw() +
scale_alpha_discrete(range=c(0.5, 1)) +
ylab("Proportion")
## Proportions, all groups/types together sum to 1 (not wanted)
p + geom_histogram(aes(y=..count../sum(..count..)), position=position_dodge())
## Look at groups
stuff <- ggplot_build(p)
stuff$data[[1]]
## The long way works: proportions by group/type
p + geom_histogram(
aes(y=c(..count..[..group..==1] / sum(..count..[..group..==1]),
..count..[..group..==2] / sum(..count..[..group..==2]),
..count..[..group..==3] / sum(..count..[..group..==3]),
..count..[..group..==4] / sum(..count..[..group..==4]))),
position='dodge'
)
## Why can't I call sapply there?
p + geom_histogram(
aes(y=sapply(unique(..group..), function(g)
..count..[..group..==g] / sum(..count..[..group..==g]))),
position='dodge'
)
Error in get(as.character(FUN), mode = "function", envir = envir) :
object 'expr' of mode 'function' was not found
So, the issue arises because of a recursive call to ggplot2:::strip_dots for any aesthetics that include 'calculated aesthetics'. There is some discussion around the calculated aesthetics in this SO question and answer. The relevant code in layer.r is here:
new <- strip_dots(aesthetics[is_calculated_aes(aesthetics)])
i.e. strip_dots is called only if there are calculated aesthetics, defined using the regex "\\.\\.([a-zA-z._]+)\\.\\.".
strip_dots in takes a recursive approach, working down through the nested calls and stripping out the dots. The code is like this:
function (expr)
{
if (is.atomic(expr)) {
expr
}
else if (is.name(expr)) {
as.name(gsub(match_calculated_aes, "\\1", as.character(expr)))
}
else if (is.call(expr)) {
expr[-1] <- lapply(expr[-1], strip_dots)
expr
}
else if (is.pairlist(expr)) {
as.pairlist(lapply(expr, expr))
}
else if (is.list(expr)) {
lapply(expr, strip_dots)
}
else {
stop("Unknown input:", class(expr)[1])
}
}
If we supply an anonymous function this code as follows:
anon <- as.call(quote(function(g) mean(g)))
ggplot2:::strip_dots(anon)
we reproduce the error:
#Error in get(as.character(FUN), mode = "function", envir = envir) :
# object 'expr' of mode 'function' was not found
Working through this, we can see that anon is a call. For calls, strip_dots will use lapply to call strip_dots on the second and third elements of the call. For an anonymous function like this, the second element is the formals of the function. If we look at the formals of anon using dput(formals(eval(anon))) or dput(anon[[2]]) we see this:
#pairlist(g = )
For pairlists, strip_dots tries to lapply it to itself. I'm not sure why this code is there, but certainly in this circumstance it leads to the error:
expr <- anon[[2]]
lapply(expr, expr)
# Error in get(as.character(FUN), mode = "function", envir = envir) :
# object 'expr' of mode 'function' was not found
TL; DR At this stage, ggplot2 doesn't support the use of anonymous functions within aes where a calculated aesthetic (such as ..count..) is used.
Anyway, the desired end result can be achieved using dplyr; in general I think it makes for more readable code to separate out the data summarisation from the plotting:
newDat <- dat %>%
group_by(died, type, group) %>%
summarise(count = n()) %>%
group_by(type, group) %>%
mutate(Proportion = count / sum(count))
p <- ggplot(newDat, aes(x = died, y = Proportion, group = interaction(group, type), fill=group, alpha=type)) +
theme_bw() +
scale_alpha_discrete(range=c(0.5, 1)) +
geom_bar(stat = "identity", position = "dodge")
ggplot2 fix
I've forked ggplot2 and have made two changes to aes_calculated.r which fix the problem. The first was to correct the handling of pairlists to lapply strip_dots instead of expr, which I think must have been the intended behaviour. The second was that for formals with no default value (like in the examples provided here), as.character(as.name(expr)) throws an error because expr is an empty name, and while this is a valid construct, it's not possible to create one from an empty string.
Forked version of ggplot2 at https://github.com/NikNakk/ggplot2 and pull request just made.
Finally, after all that, the sapply example given doesn't work because it returns a 2 row by 4 column matrix rather than an 8 length vector. The corrected version is like this:
p + geom_histogram(
aes(y=unlist(lapply(unique(..group..), function(g)
..count..[..group..==g] / sum(..count..[..group..==g])))),
position='dodge'
)
This gives the same output as the dplyr solution above.
One other thing to note is that this lapply code assumes that the data at that stage is sorted by group. I think this is always the case, but if for whatever reason it weren't you would end up with the y data out of order. An alternative which preserves the order of the rows in the calculated data would be:
p + geom_histogram(
aes(y={grp_total <- tapply(..count.., ..group.., sum);
..count.. / grp_total[as.character(..group..)]
}),
position='dodge'
)
It's also worth being aware that these expressions are evaluated in baseenv(), the namespace of the base package. This means that any functions from other packages, even standard ones like stats and utils, need to be used with the :: operator (e.g. stats::rnorm).
After playing around a little, the problem appears to be using anonymous functions with ..group.. or ..count.. inside aes:
xy <- data.frame(x=1:10,y=1:10) #data
ggplot(xy, aes(x = x, y = sapply(y, mean))) + geom_line() #sapply is fine
ggplot(xy, aes(x = x, group = y)) +
geom_bar(aes(y = sapply(..group.., mean))) #sapply with ..group.. is fine
ggplot(xy, aes(x = x, group = y)) +
geom_bar(aes(y = sapply(..group.., function(g) {mean(g)})))
#broken, with same error
ggplot(xy, aes(x = x, group = y)) +
geom_bar(aes(y = sapply(y, function(g) {mean(g)})), stat = "identity")
#sapply with anonymous functions works fine!
It seems like a really weird bug, unless I'm missing something stupid.
Related
The aim of this script was to replicate something like the figure below:
found on: https://robjhyndman.com/hyndsight/tscv/
The problem I have encountered relates to (I think) how R is handling my promises in ggplot.
Below is an example which reproduces my problem.
library(tidyverse)
process_starting_row <- 600
per_validation_period <- 30
number_of_validations <- 5
graphical_data <- data.frame(x= 1:(process_starting_row + 1 + (number_of_validations)*per_validation_period))
for (it in 1:number_of_validations) {
# For this graph there is always a line and then a colour component explaining each one...
graphical_data[,paste0("iteration",it,"line")] <- c(it)
# First make the whole row grey and then "dolly up" the colours.
graphical_data[,paste0("iteration",it,"colour")] <- "grey"
graphical_data[1:(process_starting_row + (it-1)*per_validation_period), paste0("iteration",it,"colour")] <- "blue"
graphical_data[(process_starting_row + 1 + (it)*per_validation_period), paste0("iteration",it,"colour")] <- "red"
}
#graphical_data
The above code creates a dataframe object which could be used to create the desired figure. For each iteration (in the original figure a different line) it creates a vector corresponding to the iterations "height" above the axis (that columns name is always iteration#line and a corresponding character vector, iteration#colour, with the colour code for each of the dots.
The next bit is to create a base ggplot object.
ggbase <- ggplot(data = graphical_data, aes(x=x)) +
coord_cartesian(xlim = c(process_starting_row-1*per_validation_period, nrow(graphical_data))) +
theme_bw()
It is upon this base object that I wish to iterate.
I wrote a function which would add each iteration gg_adding() and then another ggaddfor() which runs the for loop.
gg_adding <- function(data, iteration_sub, color_sub){
iteration_promise <- enquo(iteration_sub)
colour_promise <- enquo(color_sub)
gg <- geom_point(data = data, aes(x= x, y= !! iteration_promise, color = !! colour_promise))
return(gg)
}
ggaddfor <- function(data, gg){
ggout <- gg
for (it in 1:number_of_validations) {
#print(it)
iterationsub <- paste0("iteration",it,"line")
coloursub <- paste0("iteration",it,"colour")
ggout <- ggout + gg_adding(data, iterationsub, coloursub)
}
return(ggout)
}
When I run this function I get the following:
# Not working
ggaddfor(graphical_data, ggbase)
Which produces output that looks like this:
Clearly that's not what I was hoping for...
In order to test things I stipulated each iteration explicitly.
# Working...
ggadd <- ggbase
ggadd <- ggadd + gg_adding(graphical_data, iteration1line, iteration1colour)
ggadd <- ggadd + gg_adding(graphical_data, iteration2line, iteration2colour)
ggadd <- ggadd + gg_adding(graphical_data, iteration3line, iteration3colour)
ggadd <- ggadd + gg_adding(graphical_data, iteration4line, iteration4colour)
ggadd <- ggadd + gg_adding(graphical_data, iteration5line, iteration5colour)
This produces the desired output:
I want to put these functions into a package I'm currently writing and so explicitly stipulating the additions (as I do directly above) is not going to work...
I'm not sure why my earlier code is not producing the same results. I'm somewhat new to handling promises with the rlang package and I suspect my mistake could be there...
What worked for me is to replace your enquo() calls in your gg_adding() function by as.symbol(), so that the new function would look like this:
gg_adding <- function(data, iteration_sub, color_sub){
iteration_promise <- as.symbol(iteration_sub)
colour_promise <- as.symbol(color_sub)
gg <- geom_point(data = data, aes(x= x, y= !! iteration_promise, color = !! colour_promise))
return(gg)
}
However, in order to not duplicate your data every iteration, I would suggest this as your geom_point() call.
gg <- geom_point(aes(y= !! iteration_promise, color = !! colour_promise))
I'm tangentially familiar with tidy evaluation and quotation, but not fully. The thing that I understand is that whatever you put in aes(), will always be evaluated in context of data column names, first in the layer's data, next in the global data, unless the user is explicit in his calls (e.g aes(fill = "black") or something). Because a value for x and data are already specified in your ggbase construction, we do not need it in your geom_point() call.
I know this is maybe an unsollicited tip and I apologise, but ggplot seems to prefer to work with long data more than with wide data. What I mean with 'wide' data is that your iterations are sort of cbind()-ed together. Therefore, if you first calculate each iteration and then rbind() them together, you could shorten your script by quite a bit and circumvent the (quasi)quotation stuff altogether to produce a similar plot:
new_gr_dat <- lapply(seq_len(number_of_validations), function(it){
df <- data.frame(x= 1:(process_starting_row + 1 + (number_of_validations)*per_validation_period),
line = it, # doubles as y-value and iteration tracker
colour = "grey")
df[1:(process_starting_row + (it-1)*per_validation_period), "colour"] <- "blue"
df[(process_starting_row + 1 + (it)*per_validation_period), "colour"] <- "red"
return(df)
})
new_gr_dat <- do.call(rbind, new_gr_dat)
ggplot(new_gr_dat, aes(x = x, y = line, colour = colour)) +
geom_point() +
coord_cartesian(xlim = c(process_starting_row-1*per_validation_period, max(new_gr_dat$x)))
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")
Since I will need to make a lot of different plots in R I'm trying to put some more logic in preparing the data (add column names corresponding to the aesthetics) and less logic in the plot itself.
Consider the following default iris plot:
library(ggplot2)
library(data.table)
scatter <- ggplot(data=iris, aes(x = Sepal.Length, y = Sepal.Width))
scatter + geom_point(aes(color=Species, shape=Species))
Now I make a modified iris data with column names matching to the desired aesthetics:
iris2 <- as.data.table(iris)
iris2 <- iris2[,.(x=Sepal.Length, y=Sepal.Width, color=Species,
shape=Species)]
That I want to plot in a function in such a way that it basically builds the following command only slightly more dynamic, so you use all the aesthetics supplied in the data.
ggplot(data, aes(x=x, y=y)) + geom_point(aes(color=color, shape=shape))
It has been a long time since I read anything about nonstandard evaluation, expressions and quotation and I noticed that there are quite some developments with rlang and quosures (cheatsheet). [This] question was kind of helpful, but it did not resolve the fact that I want to infer the aesthetics from the data.
In the end I have tried a lot of stuff, and looked inside aes. In there I see:
exprs <- rlang::enquos(x = x, y = y, ...)
and I think this is the reason that all attempts that I made like:
ggplot(iris2, aes(x=x, y=y)) +
geom_point(aes(rlang::quo(expr(color=color))))
did not work out since aes is trying to 'enquos' my quosure(s).
QUESTION Is there any way to supply arguments to aes in a dynamic way based on the contents of the data (so you do not know in advance which aesthetics you will need?
If my question is not clear enough, in the end I made something that works, only I have a feeling that this totally not necessary because I don't know/understand the right way to do it. So the stuff below works and is what I have in mind, but what I e.g. don't like is that I had to modify aes:
The block below is stand alone and can be executed without the code chunks above.
library(data.table)
library(ggplot2)
library(rlang)
iris2 <- as.data.table(iris)
iris2 <- iris2[,.(x=Sepal.Length, y=Sepal.Width, color=Species, shape=Species)]
myaes <- function (x, y, myquo=NULL, ...) {
exprs <- rlang::enquos(x = x, y = y, ...)
exprs <- c(exprs, myquo)
is_missing <- vapply(exprs, rlang::quo_is_missing, logical(1))
aes <- ggplot2:::new_aes(exprs[!is_missing], env = parent.frame())
ggplot2:::rename_aes(aes)
}
generalPlot <- function(data, f=geom_point,
knownaes=c('color'=expr(color), 'shape'=expr(shape))){
myquo <- list()
for(i in names(knownaes)){
if(i %in% names(data)){
l <- list(rlang::quo(!!knownaes[[i]]))
names(l) <- i
myquo <- c(myquo, l)
}
}
ggplot(data, aes(x=x, y=y)) +
f(myaes(myquo=myquo))
}
generalPlot(iris2[,.(x, y, color)])
generalPlot(iris2[,.(x, y, color, shape)])
You can use this custom function that parses input data colnames and generates an aes text string that is passed to eval().
generateAES <- function(foo) {
eval(parse(text = paste0("aes(",
paste(
lapply(foo, function(i) paste(i, "=", i)),
collapse = ","),
")"
)))
}
You can use it with:
ggplot(iris2, generateAES(colnames(iris2))) +
geom_point()
Or with pipes:
library(magrittr)
iris2 %>%
ggplot(generateAES(colnames(.))) +
geom_point()
generateAES output is aes like:
Aesthetic mapping:
* `x` -> `x`
* `y` -> `y`
* `colour` -> `color`
* `shape` -> `shape`
That is generated from text string "aes(x = x,y = y,color = color,shape = shape)"
So if your data as a "color" or "shape" column, you just want to map that to the color or shape aesthetic? I think a simpler way to do that would be
generalPlot <- function(data, f=geom_point, knownaes=c('color', 'shape')) {
match_aes <- intersect(names(data), knownaes)
my_aes_list <- purrr::set_names(purrr::map(match_aes, rlang::sym), match_aes)
my_aes <- rlang::eval_tidy(quo(aes(!!!my_aes_list)))
ggplot(data, aes(x=x, y=y)) +
f(mapping=my_aes)
}
Then you can do
generalPlot(iris2[,.(x, y)])
generalPlot(iris2[,.(x, y, color)])
generalPlot(iris2[,.(x, y, color, shape)])
and it doesn't require the additional myaes function.
I'm kind of surprised I had to use eval_tidy but for some reason you can't seem to use !!! with aes().
x <- list(color=sym("color"))
ggplot(iris2, aes(x,y)) + geom_point(aes(!!!x))
# Error: Can't use `!!!` at top level
(Tested with ggplot2_3.1.0)
Before you mark as dup, I know about Use character string as function argument, but my use case is slightly different. I don't need to pass a parameter INSIDE the function, I would like to pass a dynamic number of parameters after a + (think ggplot2).
(Note: Please don't format and remove the extra-looking ####, I have left them in so people can copy paste the code into R for simplicity).
This has been my process:
#### So let's reproduce this example:
library(condformat)
condformat(iris[c(1:5,70:75, 120:125),]) +
rule_fill_discrete(Species) +
rule_fill_discrete(Petal.Width)
#### I would like to be able to pass the two rule_fill_discrete() functions dynamically (in my real use-case I have a variable number of possible inputs and it's not possible to hardcode these in).
#### First, create a function to generalize:
PlotSeries <- function(x){
b=NULL
for (i in 1:length(x)){
a <- paste('rule_fill_discrete(',x[i],')',sep="")
b <- paste(paste(b,a,sep="+"))
}
b <- gsub("^\\+","",b)
eval(parse(text = b))
}
#### Which works with one argument
condformat(iris[c(1:5,70:75, 120:125),]) +
PlotSeries("Species")
#### But not if we pass two arguments:
condformat(iris[c(1:5,70:75, 120:125),]) +
PlotSeries(c("Species","Petal.Width"))
Error in rule_fill_discrete(Species) + rule_fill_discrete(Petal.Width) :
non-numeric argument to binary operator
#### It will work if we call each individually
condformat(iris[c(1:5,70:75, 120:125),]) +
PlotSeries("Species") +
PlotSeries("Petal.Width")
#### Which gives us an indication as to what the problem is... the fact that it doesn't like when the rule_fill_discrete statements are passed in as one statement. Let's test this:
condformat(iris[c(1:5,70:75, 120:125),]) +
eval(rule_fill_discrete(Species) +
rule_fill_discrete(Petal.Width) )
Error in rule_fill_discrete(Species) + rule_fill_discrete(Petal.Width) :
non-numeric argument to binary operator
#### Fails. But:
condformat(iris[c(1:5,70:75, 120:125),]) +
eval(rule_fill_discrete(Species)) +
eval(rule_fill_discrete(Petal.Width) )
#### This works. But we need to be able to pass in a GROUP of statements (that's kinda the whole point). So let's try to get the eval statements in:
Nasty <- "eval(rule_fill_discrete(Species)) eval(rule_fill_discrete(Petal.Width))"
condformat(iris[c(1:5,70:75, 120:125),]) + Nasty #### FAIL
Error in +.default(condformat(iris[c(1:5, 70:75, 120:125), ]), Nasty) :
non-numeric argument to binary operator
condformat(iris[c(1:5,70:75, 120:125),]) + eval(Nasty) #### FAIL
Error in +.default(condformat(iris[c(1:5, 70:75, 120:125), ]), eval(Nasty)) :
non-numeric argument to binary operator
condformat(iris[c(1:5,70:75, 120:125),]) + parse(text=Nasty) #### FAIL
Error in +.default(condformat(iris[c(1:5, 70:75, 120:125), ]), parse(text = Nasty)) :
non-numeric argument to binary operator
condformat(iris[c(1:5,70:75, 120:125),]) + eval(parse(text=Nasty)) #### FAIL
Error in eval(rule_fill_discrete(Species)) + eval(rule_fill_discrete(Petal.Width)) :
non-numeric argument to binary operator
So how can we do it?
Thanks to this stackoverflow question and thanks to the bug report from #amit-kohli, I was made aware that there was a bug in the condformat package.
Update: Answer updated to reflect the new condformat API introduced in condformat 0.7.
Here I show how to (using condformat 0.7.0). Note that the syntax I use in the standard evaluation function is derived from the rlang package.
Install condformat:
install.packages("condformat)"
A simple example, asked in the question:
# Reproduce the example
library(condformat)
condformat(iris[c(1:5,70:75, 120:125),]) %>%
rule_fill_discrete(Species) %>%
rule_fill_discrete(Petal.Width)
# With variables:
col1 <- rlang::quo(Species)
col2 <- rlang::quo(Petal.Width)
condformat(iris[c(1:5,70:75, 120:125),]) %>%
rule_fill_discrete(!! col1) %>%
rule_fill_discrete(!! col2)
# Or even with character strings to give the column names:
col1 <- "Species"
col2 <- "Petal.Width"
condformat(iris[c(1:5,70:75, 120:125),]) %>%
rule_fill_discrete(!! col1) %>%
rule_fill_discrete(!! col2)
# Do it programmatically (In a function)
#' #importFrom magrittr %>%
some_color <- function(data, col1, col2) {
condformat::condformat(data) %>%
condformat::rule_fill_discrete(!! col1) %>%
condformat::rule_fill_discrete(!! col2)
}
some_color(iris[c(1:5,70:75, 120:125),], "Species", "Petal.Width")
A more general example, using an expression:
# General example, using an expression:
condformat(iris[c(1:5,70:75, 120:125),]) %>%
rule_fill_gradient(Species, expression = Sepal.Width - Sepal.Length)
# General example, using a column given as character and an
# expression given as character as well:
expr <- rlang::parse_expr("Sepal.Width - Sepal.Length")
condformat(iris[c(1:5,70:75, 120:125),]) %>%
rule_fill_gradient("Species", expression = !! expr)
# General example, in a function, everything given as a character:
two_column_difference <- function(data, col_to_colour, col1, col2) {
expr1 <- rlang::parse_expr(col1)
expr2 <- rlang::parse_expr(col2)
condformat::condformat(data) %>%
condformat::rule_fill_gradient(
!! col_to_colour,
expression = (!!expr1) - (!!expr2))
}
two_column_difference(iris[c(1:5,70:75, 120:125),],
col_to_colour = "Species",
col1 = "Sepal.Width",
col2 = "Sepal.Length")
Custom discretized scales for continuous values
Custom discrete color values can be specified with a function that preprocesses a continuous column into a discrete scale:
discretize <- function(column) {
sapply(column,
FUN = function(value) {
if (value < 4.7) {
return("low")
} else if (value < 5.0) {
return("mid")
} else {
return("high")
}
})
}
And we can specify the colors for each of the levels of the scale using colours =:
condformat(head(iris)) %>%
rule_fill_discrete(
"Sepal.Length",
expression = discretize(Sepal.Length),
colours = c("low" = "red", "mid" = "yellow", "high" = "green"))
If we want, the discretize function can return colours:
discretize_colours <- function(column) {
sapply(column,
FUN = function(value) {
if (value < 4.7) {
return("red")
} else if (value < 5.0) {
return("yellow")
} else {
return("green")
}
})
}
The code to use it:
condformat(head(iris)) %>%
rule_fill_discrete(
"Sepal.Length",
expression = discretize_colours(Sepal.Length),
colours = identity)
Note that as expression returns the colours we use colours = identity. identity is just function(x) x.
Finally, using some rlang tidy evaluation we can create a function:
colour_based_function <- function(data, col1) {
col <- rlang::parse_expr(col1)
condformat::condformat(data) %>%
condformat::rule_fill_discrete(
columns = !! col1,
expression = discretize_colours(!! col),
colours = identity)
}
colour_based_function(head(iris), "Sepal.Length")
NOTE: This answer provides a workaround for a bug in an old version of condformat. The bug has since been fixed, see #zeehio's answer for the current version after this bug was fixed.
I think you have two mostly separate questions. That are all mixed together in your post. I will attempt to restate and answer them individually, and then put things together - which doesn't work all the way at this point but gets close.
First, let's save some typing by defining a couple variables:
ir = iris[c(1:5,70:75, 120:125), ]
cf = condformat(ir)
Q1: How do I use + on a vector or list of inputs?
This is the easy question. The base answer is Reduce. The following are all equivalent:
10 + 1 + 2 + 5
"+"("+"("+"(10, 1), 2), 5)
Reduce("+", c(1, 2, 5), init = 10))
More pertinent to your case, we can do this to replicate your desired output:
fills = list(rule_fill_discrete(Species), rule_fill_discrete(Petal.Width))
res = Reduce(f = "+", x = fills, init = cf)
res
Q2: How do I use string inputs with rule_fill_discrete?
This is my first time using condformat, but it looks to be written in the lazyeval paradigm with rule_fill_discrete_ as a standard-evaluating counterpart to the non-standard-evaluating rule_fill_discrete. This example is even given in ?rule_fill_discrete, but it doesn't work as expected
cf + rule_fill_discrete_(columns = "Species")
# bad: Species column colored entirely red, not colored by species
# possibly a bug? At the very least misleading documentation...
cf + rule_fill_discrete_(columns = "Species", expression = expression(Species))
# bad: works as expected, but still uses an unquoted Species
# other failed attempts
cf + rule_fill_discrete_(columns = "Species", expression = expression("Species"))
cf + rule_fill_discrete_(columns = "Species", expression = "Species")
# bad: single color still single color column
There is also an env environment argument in the SE function, but I had no luck with that either. Maybe someone with more lazyeval/expression experience can point out something I'm overlooking or doing wrong.
Work-around: What we can do is pass the column directly. This works because we're not doing any fancy functions of the column, just using it's values directly to determine the coloring:
cf + rule_fill_discrete_(columns = c("Species"), expression = ir[["Species"]])
# hacky, but it works
Putting it together
Using the NSE version with Reduce is easy:
fills = list(rule_fill_discrete(Species), rule_fill_discrete(Petal.Width))
res = Reduce(f = "+", x = fills, init = cf)
res
# works!
Using SE with input strings, we can use the hacky workaround.
input = c("Species", "Petal.Width")
fills_ = lapply(input, function(x) rule_fill_discrete_(x, expression = ir[[x]]))
res_ = Reduce(f = "+", x = fills_, init = cf)
res_
# works!
And this, of course, you could wrap up into a custom function that takes a data frame and a string vector of column names as input.
#Gregor's answer was perfect. A bit hacky, but works excellently.
In my use-case, I needed a bit more complication, I will post it here in case it's useful to somebody else.
In my use-case, I needed to be able to color multiple columns based on the values of one column. condformat allows us to do this already, but again we run into the parametrization problem. Here's my solution to that, based on the response by Gregor:
CondFormatForInput <- function(Table,VectorToColor,VectorFromColor) {
cf <- condformat(Table)
input = data.frame(Val=VectorToColor,
Comp=VectorFromColor)
fills2_ = map2(input$Val,.y = input$Comp,.f = function(x,y) rule_fill_discrete_(x, expression =
iris[[y]]))
res_ = Reduce(f = "+", x = fills2_, init = cf)
res_
}
CondFormatForInput(iris,
c("Sepal.Length","Sepal.Width","Petal.Length","Petal.Width"),
c("Sepal.Width","Sepal.Width","Petal.Width","Petal.Width"))
I'll skip right to an example and comment afterwords:
cont <- data.frame(value = c(1:20),variable = c(1:20,(1:20)^1.5,(1:20)^2),group=rep(c(1,2,3),each=20))
value variable group
1 1 1.000000 1
2 2 2.000000 1
3 3 3.000000 1
#... etc.
#ser is shorthand for "series".
plot_scat <- function(data,x,y,ser) {
ggplot(data,aes(x=x,y=y,color=factor(ser)))+geom_point()
}
plot_scat(cont,value,variable,group)
#This gives the error:
#Error in eval(expr,envir,enclose) : object 'x' not found
Now, I know that ggplot2 has a known bug where aes() will only look in the global environent and not in the local environment. Following advice from: Use of ggplot() within another function in R, I tried another route.
plot_scat <- function(data,x,y,ser) {
#environment=environment() added
ggplot(data,aes(x=x,y=y,color=factor(ser)),environment=environment())+geom_point()
}
plot_scat(cont,value,variable,group)
#This gives the error:
#Error in eval(expr,envir,enclos) : object 'value' not found
#In addition: Warning message:
#In eval(expr,envir,enclos) : restarting interrupted promise evaluation
I don't know what that last line means. If I call:
ggplot(cont,aes(x=value,y=variable,color=group))+geom_point()
I get the graph you would expect. At the command line, aes() is looking for the variable names in ggplot(), but it is not doing this within the function call. So I tried to change my call:
plot_scat(cont,cont$value,cont$variable,cont$group)
This gets me what I want. So I add the next layer of complexity:
plot_scat <- function(data,x,y,ser) {
#added facet_grid
ggplot(data,aes(x=x,y=y,color=factor(ser)),environment=environment())+geom_point()+
facet_grid(.~ser)
}
plot_scat(cont,cont$value,cont$variable,cont$group)
#This gives the error:
#Error in layout_base(data, cols, drop = drop):
# At least one layer must contain all variables used for facetting
My thought on this is that ser is actually cont$group, which is fine for use in aes(), but when passed to facet_grid is now a one column data frame with no information about value and variables. According to the help page, facet_grid does not take a "data=" argument so I cant use facet_grid(data=data,.~ser) to get around this. I don't know how to proceed from here.
This is an extremely simple example, but the long term goal is to have a function I can give to non-R-literate people in my office and say "give it your data frame name, column names and the column you want to split on and it will make pretty plots for you". It will also get a lot more complex, with a very customized theme, which is irrelevant to the problems I'm having.
If you do not want to pass your variables (column names) as strings/quoted, then one approach that I tried (see also here) was to make use of match.call() and eval. It works with faceting (as in your case) as well:
library(ggplot2)
cont <- data.frame( value = c(1:20),
variable = c(1:20, (1:20) ^ 1.5, (1:20) ^ 2),
group = rep(c(1, 2, 3), each = 20))
plot_scat <- function(data, x, y, ser) {
arg <- match.call()
ggplot(data, aes(x = eval(arg$x),
y = eval(arg$y),
color = factor(eval(arg$ser)))) +
geom_point() +
facet_grid(. ~ eval(arg$ser))
}
# Call your custom function without quoting the variables
plot_scat(data = cont, x = value, y = variable, ser = group)
To get an idea what match.call() does, maybe try to run this:
plot_scat <- function(data, x, y, ser) {
str(as.list(match.call()))
}
plot_scat(cont, value, variable, group)
#> List of 5
#> $ : symbol plot_scat
#> $ data: symbol cont
#> $ x : symbol value
#> $ y : symbol variable
#> $ ser : symbol group
Created on 2019-01-10 by the reprex package (v0.2.1)
Or, another workaround, but this time with passing quoted column names to the custom plotting function is using get():
plot_scat <- function(data, x, y, ser) {
ggplot(data, aes(x = get(x),
y = get(y),
color = factor(get(ser)))) +
geom_point() +
facet_grid(. ~ get(ser))
}
plot_scat(data = cont, x = "value", y = "variable", ser = "group")
You could use aes_string() in place of aes() and pass the column names as strings.
plot_scat <- function(data,x,y,ser) {
ser_col = paste("factor(",ser,")")
ggplot(data,aes_string(x=x,y=y,col=ser_col))+geom_point()+facet_grid(as.formula(sprintf('~%s',ser)))
}
plot_scat(cont,"value","variable","group")
facet_grid requires a formula so you can use as.formula to parse the string to a formula.