I want to use a function to modify a plot based on the parameters passed. However, I'm not sure what format I should convert the list of modifications parameters into, to be used as parameters within the respective 'geom'.
library(ggplot2)
data <- tibble(a = 1:3, b = 11:13)
p <- ggplot(data)
plot_modify <- function(p, geom = "", ...){
modifications <- list(...)
if(geom == "point"){
p <- p + geom_point(aes(x = a, y = b), modifications)
}
return(p)
}
plot_modify(p, "point", alpha=0.1, size = 0.3)
P.s. I intend to validate the list of parameters based on each 'geom' later on.
After you capture the values in the ellipse, you are responsible for passing them along. In order to inject those values into subsequent calls, you'll need to build the call using something like do.call using base R methods
plot_modify <- function(p, geom = "", ...){
modifications <- list(...)
if(geom == "point"){
p <- p + do.call("geom_point", c(list(aes(x = a, y = b)), modifications))
}
return(p)
}
But do note that list(...) will force evaluation of all your parameters which is slightly different than how the function behaves normally.
If you wanted to use more of an rlang strategy you can do
plot_modify <- function(p, geom = "", ...){
modifications <- list(...)
if(geom == "point"){
p <- p + rlang::inject(geom_point(aes(x = a, y = b), !!!modifications))
}
return(p)
}
Related
I have the following equation: y = 1 - cx, where c is a real number.
I'm trying to make something where I can pick the range of values for c and plot all the graphs of every function with the corresponding c.
Here's what I got as of now:
p <- ggplot(data = data.frame(x = 0), mapping = aes(x = x))
statfun1 <- c()
for (i in 1:3){
c <- i
fun1.i <- function(x){1 - c*x}
fun1.i.plot <- stat_function(fun = fun1.i, color="red")
statfun1 <- statfun1 + fun1.i.plot
}
p + statfun1 + xlim(-5, 5)
The p is basically what you need in ggplot2 to plot a function, then I go over in this case the values 1, 2 and 3 for c and I try to add them all at the end but this does not seem to work. Anyone maybe can help me out or put me on the right track?
Define your function
fun1.i <- function(x, c){1 - c*x}
Now from ?`+.gg`
You can add any of the following types of objects:
...
You can also supply a list, in which case each element of the list will be added in turn.
So you might use lapply
p + xlim(-5, 5) + lapply(1:3, function(c) {
stat_function(fun = fun1.i, args = list(c = c), geom = "line", color="red")
})
Result
I am writing a plotting method for class "foo". I would like this plot function to take multiple foo objects and plot them on the same graph.
The Code
#parabola function
parabolas <- function(x, parm) {
y <- parm[1]*(x^2)+parm[2]*x+parm[3]
return(y)
}
#make foo object
make_foo <- function(a, b, c) {
x <- runif(100, 0 , 20)
y <- parabolas(x = x, parm = c(a,b,c)) + rnorm(100, mean = 100 ,sd = 100)
foo <- list(data = data.frame(x = x, y = y), parameters = c(a,b,c))
class(foo) <- "foo"
return(foo)
}
#plot function
plot.foo <- function(x,
...,
labels) {
a <- ggplot(NULL, aes(x = x, y = y))
foo.list <- list(x, ...)
#browser()
#build plot
for(i in 1:length(foo.list)){
foo.obj <- foo.list[[i]]
foo.obj$data$lab <- factor(rep(labels[i], nrow(foo.obj$data)), levels = labels)
a <- a + geom_point(data = foo.obj$data, size = 5, alpha = .7, aes(color = lab))
a <- a + stat_function(data = foo.obj$data,
fun = parabolas,
args = list(parm = foo.obj$parameters), size = 1.2)
}
return(a)
}
The Problem
ggplot will relevel the factor levels of lab according to the alphabetical order of the factor labels. I do not know how to choose the factor level order for lab when adding these layers sequentially. I would like for the first element of labels to correspond to the first foo object plotted, and the second element to correspond to the second foo object, and so forth and so forth.
foo1 <- make_foo(2, 10, 3)
foo2 <- make_foo(-6, -3, 2000)
plot(foo1, foo2, labels = c("obj1","obj2"))
#label for foo1 is "obj1" and label for foo2 is "obj2"
plot(foo1, foo2, labels = c("obj3","obj2"))
#label for foo1 should be "obj3" and label for foo2 should be "obj2"
The motivation
The reason I structure the plot function like this as opposed to binding the data frames together and assigning the correct factor levels to lab is because in that particular case, facet_wrap and stat_function do not work well together. After applying multiple stat_function and using facet_wrap together, all curves will appear in each panel. This thread illustrates a similar problem.
Because I have these different layers limited to different data sets, facet_wrap will correctly facet each stat_function plot according to the data/parameters used to draw it.
plot(foo1, foo2, labels = c("z","a")) + facet_wrap(~lab, scales = "free")
#Shows facet_wrap works as intended but the labels for foo1 and foo2 are
#still not in the intended order
You can manually override the order of the color scale by setting the limits. Here is how:
plot.foo <- function(x,
...,
labels) {
a <- ggplot(NULL, aes(x = x, y = y))
foo.list <- list(x, ...)
#browser()
#build plot
for(i in 1:length(foo.list)){
foo.obj <- foo.list[[i]]
foo.obj$data$lab <- factor(rep(labels[i], nrow(foo.obj$data)), levels = labels)
a <- a + geom_point(data = foo.obj$data, size = 5, alpha = .7, aes(color = lab))
a <- a + stat_function(data = foo.obj$data,
fun = parabolas,
args = list(parm = foo.obj$parameters), size = 1.2)
}
### added line:
a <- a + scale_color_discrete(limits = labels)
###
return(a)
}
I'm needing help with the following question:
Consider the following R function, named negloglike that has two input arguments: lam and x, in that order.
Use this function to produce a plot of the log-likelihood function over a range of values λ ∈ (0, 2).
negloglike <- function(lam, x) {
l = -sum(log(dexp(x, lam)))
return(l)
}
Can anyone please help? Is it possible to do something like this with ggplot? I've been trying to do it with a set value of lam (like 0.2 here for example) using stat_function:
ggplot(data = data.frame(x = 0), mapping = aes(x = x)) +
stat_function(fun = negloglike, args = list(lam = 0.2)) +
xlim(0,10)
but the plot always returns a horizontal line at some y-value instead of returning a curve.
Should I be possibly using a different geom? Or even a different package altogether?
Much appreciated!
The trick is to Vectorize the function over the argument of interest.
Thanks for the tip go to the most voted answer to this question. It uses base graphics only, so here is a ggplot2 equivalent.
First I will define the negative log-likelihood using function dexp
library(ggplot2)
negloglike <- function(lam, x) {negloglike <- function(lam, x) {
l = -sum(dexp(x, lam, log = TRUE))
return(l)
}
nllv <- Vectorize(negloglike, "lam")
But it's better to use the analytic form, which is easy to establish by hand.
negloglike2 <- function(lam, x) {
l = lam*sum(x) - length(x)*log(lam)
return(l)
}
nllv2 <- Vectorize(negloglike2, "lam")
ggplot(data = data.frame(lam = seq(0, 2, by = 0.2)), mapping = aes(x = lam)) +
stat_function(fun = nllv2, args = list(x = 0:10))
Both nllv and nllv2 give the same graph.
I'm trying to write a function that can be called using the '+'-based ggplot2 syntax.
myplot + myfunction
Specifically, the function I'm writing symmetrizes the y-axis about zero, so it needs to determine the y-axis range for the input plot.
So let,
ylim_sym <- function(p){
get_y_range <- function(p){
ggplot2::ggplot_build(p)$layout$panel_ranges[[1]]$y.range
}
max_offset <- max(abs(get_y_range(p)))
p + ylim(- max_offset, max_offset)
}
With this function, the following works:
qplot(x = 1:10, y = exp(rnorm(10))) %>% ylim_sym()
But this doesn't work because of some precedence issue between +.gg and %>%:
qplot(x = 1:10, y = exp(rnorm(10))) +
geom_abline(slope = 0) %>%
ylim_sym()
(I could write the latter (all_my_ggplot_pipeline) %>% ylim_sym() but it's pretty ugly syntax).
Ideally, I'd like to be able to write ylim_sym such that it can be piped like so,
qplot(x = 1:10, y = exp(rnorm(10))) + ylim_sym()
but I can't work out how to access the plot on the LHS of + within ylim_sym
Any ideas?
I was able to solve it by doing the following.
StatSymYLim <- ggproto(
"StatSymYLim", Stat,
compute_group = function(data, scales) {
out <- data.frame(
x = median(data$x),
y = c(-1, 1) * max(abs(data$y))
)
out
},
required_aes = c("x", "y")
)
ylim_sym <- function(...){
geom_blank(..., stat = StatSymYLim)
}
Then the following works as required:
qplot(x = 1:10, y = exp(rnorm(10))) +
geom_abline(slope = 0) +
ylim_sym()
My understanding of ggplot2 internals is pretty shaky to be fair, so this might be a naive solution.
Note: your function needs an update as the structure of the object has slightly changed
Using package ggfun this would work:
# devtools::install_github("moodymudskipper/ggfun")
library(ggfun)
ylim_sym <- function(p){
get_y_range <- function(p){
ggplot2::ggplot_build(p)$layout$panel_params[[1]]$y.range
}
max_offset <- max(abs(get_y_range(p)))
p + ylim(- max_offset, max_offset)
}
qplot(x = 1:10, y = exp(rnorm(10))) +
geom_abline(slope = 0) +
ylim_sym
I'm working on a package that will make it easier for other users at my company to use ggplot2. One of the things I would like to do is to add a function that automatically formats ugly variable names to pretty titles.
I have a function that does this already. Let's assume there's some dummy data and a basic plot:
data <- data.frame(
place_name = c("Los Angeles","New York"),
some_amount = c(5,10)
)
g <- ggplot(data, aes(x = place_name, y = some_amount)) +
geom_bar(stat = 'identity') +
labs(title = "test_of_function")
So I have my ggplot, and I want to format the titles. This function works fine once I apply it to the labels of a function.
format_title <- function(...,sep = "[^[:alnum:]]+"){
args <- list(...)
if (is.list(args[[1]]))
args <- args[[1]]
lapply(args, function(x, sep){
stringr::str_to_title(stringr::str_replace_all(x,sep," "))
}, sep = sep)
}
format_plot_titles <- function(g){
g$labels <- format_title(g$labels)
g
}
So now if we compare them:
g
format_plot_titles(g)
What I was hoping to do is add it via the ggplot2 +, but in order to do that I need access to what the previous labels of the plot were.
It would look something like this (with better names):
ggplot(data, aes(x = place_name, y = some_amount)) +
geom_bar() +
title_labels()
I'm having a lot of trouble figuring out how to access the labels of the previous plot as I attempt to layer the new labels on top of the old one. Any help is appreciated!
Edit: Solved this. There was no slick solution though. I basically had to overwrite the default s3 method for the + that ggplot2 exports to take in a new type of object I'm calling a "formatter". This allows me to construct a method that checks for the formatter class, and if my object does inherit the formatter class, it applies that formatter to the plot labels. Here's the code:
`+.gg` <- function (e1, e2) {
e2name <- deparse(substitute(e2))
if (ggplot2::is.theme(e1))
ggplot2:::add_theme(e1, e2, e2name)
else if (ggplot2::is.ggplot(e1) & is.formatter(e2)){
add_formatter(e1, e2, e2name)
}
else if (ggplot2::is.ggplot(e1))
ggplot2:::add_ggplot(e1, e2, e2name)
}
update_format <- function(p, formatter){
p <- ggplot2:::plot_clone(p)
p$labels <- formatter(p$labels)
p
}
add_formatter <- function(p, formatter, objectname) {
update_format(p, formatter)
}
is.formatter <- function(x){
inherits(x,"formatter")
}
format_title <- function(...,sep = "[^[:alnum:]]+"){
args <- list(...)
if (is.list(args[[1]]))
args <- args[[1]]
lapply(args, function(x, sep){
stringr::str_to_title(stringr::str_replace_all(x,sep," "))
}, sep = sep)
}
title_labels <- function(...){
structure(format_title, class = "formatter")
}
ggplot(data, aes(x = place_name, y = some_amount)) +
geom_bar(stat = 'identity') +
title_labels()
Posting edit as a formal answer.
Solved this. There was no slick solution though. I basically had to overwrite the default s3 method for the + that ggplot2 exports to take in a new type of object I'm calling a "formatter". This allows me to construct a method that checks for the formatter class, and if my object does inherit the formatter class, it applies that formatter to the plot labels. Here's the code:
`+.gg` <- function (e1, e2) {
e2name <- deparse(substitute(e2))
if (ggplot2::is.theme(e1))
ggplot2:::add_theme(e1, e2, e2name)
else if (ggplot2::is.ggplot(e1) & is.formatter(e2)){
add_formatter(e1, e2, e2name)
}
else if (ggplot2::is.ggplot(e1))
ggplot2:::add_ggplot(e1, e2, e2name)
}
update_format <- function(p, formatter){
p <- ggplot2:::plot_clone(p)
p$labels <- formatter(p$labels)
p
}
add_formatter <- function(p, formatter, objectname) {
update_format(p, formatter)
}
is.formatter <- function(x){
inherits(x,"formatter")
}
format_title <- function(...,sep = "[^[:alnum:]]+"){
args <- list(...)
if (is.list(args[[1]]))
args <- args[[1]]
lapply(args, function(x, sep){
stringr::str_to_title(stringr::str_replace_all(x,sep," "))
}, sep = sep)
}
title_labels <- function(...){
structure(format_title, class = "formatter")
}
ggplot(data, aes(x = place_name, y = some_amount)) +
geom_bar(stat = 'identity') +
title_labels()