I have a function (col_grob) that calls another function (pal_bar) with a tilde-notation expression as follows:
## plots a colour bar with specified colour intervals
pal_bar <- function(cols) {
cols <- colorRampPalette(cols)(200)
par(mar = c(0, 0, 0, 0))
plot(1:200, rep(1, 200), col = cols, pch = 15, cex = 1.1, bty = 'n', xaxt = 'n', xlab = '', yaxt = 'n', ylab = '', main="")
}
## calls pal_bar function to plot the bar as a grob, tilde expression
col_grob <- function(pal) {
g <- ggplotify::as.grob(~pal_bar(pal))
grid::grid.draw(g)
}
I am returned the error "object 'pal' not found" when I run:
col_grob(pal = c("red", "blue"))
I came across resources and similar questions but I am not able to solve the issue with my lack of understanding of the evaluation rules. I tried ~pal_bar(I(pal)), bquote() function, and possibly structure(list(), *) but do not have sufficient knowledge of each to format the syntax correctly.
How would I get col_grob(pal = c("red", "blue")) to plot the desired colour bar for me?
A possible solution:
col_grob <- function(pal) {
txt <- substitute(pal_bar(pal))
g <- ggplotify::as.grob(as.expression(txt))
grid::grid.draw(g)
}
col_grob(pal = c("red", "blue"))
Related
I'm writing a function that takes two variables -- ideally columns from the same data frame -- and plots them. The plot will also include a legend using the names from the columns, and that's where I'm running into difficulty.
The code below is as close to the desired outcome as I can get. I'm only interested in using base R.
plotpairs <- function(x,y){
plot(x, type = "l", col = "red")
lines(y, type = "l", col = "blue")
legend(0,ylim_max, legend = paste0(x, y), lwd = c(5,5), col = c("red", "blue"), bty = "n")
}
plotpairs(df$F3, df$F4)
If you supply a data.frame or matrix as argument, you can extract the column names using colnames(), else you have to use deparse(substitute()), or match.call() as I've used here.
set.seed(1)
F3 <- cumsum(runif(1e3, -2, 2))+runif(1e3)
F4 <- cumsum(rnorm(1e3))+rnorm(1e3, 0, 0.5)
df <- data.frame(F3, F4)
plotpairs <- function(x, y) {
if (NCOL(x) > 1) {
nam <- colnames(x)[1:2]
y <- x[,2]
x <- x[,1]
} else {
nam <- as.character(match.call()[c("x", "y")])
}
plot(x, type="l", col="red", ylim=range(c(x, y)))
lines(y, type="l", col="blue")
legend("topleft", legend=nam, lwd=c(5, 5), col=c("red", "blue"), bty="n")
}
plotpairs(F3, F4)
with(df, plotpairs(F3, F4)) # same
plotpairs(df) # same
This plots the indicated columns from the data frame given as first argument or if no names are given then it plots the first two columns. Note that we first plot both together using type = "n" to ensure that the plot gets set up large enough to accommodate both variables. The example uses the builtin data frame trees.
plotpairs <- function(data, name1 = names(data)[1], name2 = names(data)[2]) {
both <- c(data[[name1]], data[[name2]])
plot(seq_along(both) / 2, both, type = "n", xlab = "", ylab = "")
lines(data[[name1]], type = "l", col = "red")
lines(data[[name2]], type = "l", col = "blue")
legend("topleft", legend = c(name1, name2), lwd = 5,
col = c("red", "blue"), bty = "n")
}
plotpairs(trees, "Girth", "Volume")
I also worked out an answer based on the comment #Rui Barradas that included regex. Since I'll be using inputs like "df$F3", I can count on the "$" symbol to be present, though this might limit the flexibility of the code.
plotpairs <- function(x,y){
xnam <- deparse(substitute(x))
ynam <- deparse(substitute(y))
xnam1 <- substring(xnam, regexpr("[$]", xnam)+1)
ynam1 <- substring(ynam, regexpr("[$]", ynam)+1)
plot(x, type = "l", col = "red")
lines(y, type = "l", col = "blue")
legend("topleft", legend = c(paste0(xnam1), paste0(ynam1)),lwd = c(5,5), col = c("red", "blue"), bty = "n")
}
When writing a plotting function in R, I'd like to not modify the global environment, so I include something like
op <- par()
on.exit(par(op))
But this is less than satisfactory because it spits out warning messages (e.g., "In par(op) : graphical parameter "cin" cannot be set"), but more importantly, it is not compatible with multi-panel plots. For example, if I had a simple function like
pfun <- function(x) {
op <- par()
on.exit(par(op))
par(bg = "gray21", col = "deeppink", col.axis = "deeppink")
plot(x,
xaxt = "n",
yaxt = "n",
col = "deeppink",
cex = 2,
pch = 22,
bg = "deeppink",
col.lab = "deeppink")
axis(1, col = "deeppink")
axis(2, col = "deeppink")
}
it would work great for a single plot (apart from the warnings), but is incompatible with multi-panel plots, e.g.
par(mfrow = c(2, 2))
pfun(1:10)
pfun(10:1) # overwrites the first plot rather than plotting in the second panel
Is there a way to have the plot parameters reset on exit while also allowing for multi-panel plotting?
We can avoid interfering with multi-panel plots, by only saving /restoring the elements of par that we change in the function. In this case that means only storing bg, col, and axis.col. The important thing is to avoid interfering with the graphical parameters (particularly mfrow, mfcol and mfg) that control multiplot positions.
pfun <- function(x) {
op <- par('bg', 'col', 'col.axis')
on.exit(par(op))
par(bg = "gray21", col = "deeppink", col.axis = "deeppink")
plot(x,
xaxt = "n",
yaxt = "n",
col = "deeppink",
cex = 2,
pch = 22,
bg = "deeppink",
col.lab = "deeppink")
axis(1, col = "deeppink")
axis(2, col = "deeppink")
}
Or, even slightly neater is to make use of the fact that when we set parameters with par it invisibly returns a list of the old values of the parameters we changed. So just the following will work nicely:
op <- par(bg = "gray21", col = "deeppink", col.axis = "deeppink")
on.exit(par(op))
I am using R for plotting. When my graph plots the legend appears where I want it to be but the colors are missing. mtcars 2 is a modified version of mtcars (one of the pre-loaded data sets) that adds a model and country of origin to the data set. mtcars.pca is what I named my redundance analysis (rda function under vegan), and mtcars.clust is titled for hierarchical clustering of the continuous factors of mtcars (hclust function of vegan) Below is the code I am using with mtcars2.
pca.fig = ordiplot(mtcars.pca, type = "none", las=1, xlim=c(-15,15), ylim = c(-20,10))
points(pca.fig, "sites", pch = 19, col = "green", select = mtcars2$origin =="domestic")
points(pca.fig, "sites", pch = 19, col = "blue", select = mtcars2$origin =="foreign")
ordiellipse(mtcars.pca, mtcars2$origin, conf = 0.95, label = FALSE)
ordicluster(mtcars.pca, mtcars.clust, col = "gray")
legend("bottomright", title="Car Origin", c("domestic", "foreign"), col = "origin")
You need to specify a vector of colours in legend and also a pch:
library("vegan")
data(dune, dune.env)
ord <- rda(dune)
plot(ord, type = "n")
cols <- c("red","blue","green")
points(ord, col = cols[dune.env$Use], pch = 19)
legend("bottomright", legend = levels(dune.env$Use), bty = "n",
col = cols, pch = 19)
If you don't add pch but just use col = cols legend() doesn't display any points. Because you used pch = 19 in your points() calls, use the same in the legend() call.
Also, note how to plot points of different colours in a single pass. I have some examples and explanation that go through the indexing trick I used in my code above to achieve this in a blog post of mine from a few years ago: http://www.fromthebottomoftheheap.net/2012/04/11/customising-vegans-ordination-plots/
I came to this question having the next problem in xts object:
I wanted to plot all time-series in xts object with legend. Moreover, there were around 20.
I used (wrong):
plot(returns_xts)
addLegend(...)
Correct version:
plot(returns_xts, legend.loc = "bottomright", col=1:20, lty = 1)
There is legend.loc parameter
col = 1:20 generates colors for you
Result:
I use often scatter.smooth function but I wonder if it is possible to add a title or main argument directly to this function. I read the description of the function but have not found the possibility. I know that there are other ways to do this but I want to keep this one if possible.
d <- data.frame(x = sample(20, 500, prob=c(1:10, 10:1), replace = TRUE),
y = sample(20, 500, prob=c(1:10, 10:1), replace = TRUE),
z = rnorm(500, 20, 4))
mo <- lm(y ~ z, d)
fig <- function(x) {
scatter.smooth(fitted(x), residuals(x, type = "response"), col = "red")
abline(0, 0, lty = 2)
legend("topright", legend = c("loss", "0-0"), lty = c(1, 2))
}
fig(mo)
You look at the help page of scatter.smooth, you see that the ... argument is passed on to plot. Therefore, you can us any argument that plot accepts. Also main=.
You can also add a title to any graph using mtext which adds text to the figure margins.
So, you can do:
fig(mo)
mtext("My title", side=3, line=1)
Or modify your fig function:
fig <- function(x, ...) {
scatter.smooth(fitted(x), residuals(x, type = "response"),
col = "red", ...)
abline(0, 0, lty = 2)
legend("topright", legend = c("loss", "0-0"), lty = c(1, 2))
}
fig(mo, main="My title")
Just add main to the smooth function:
scatter.smooth(x, y, ylab = "Yname", xlab = "Xname", main = "Title")
It works
What is the best way to implement a generic plot method, given that i have 2 series + legends?
The problem is that i want to provide some nice defaults for the colors and legends, but the user should be free to change it:
obj = list(y1 = runif(100, 0, 10), y2 = runif(100, 20, 30))
class(obj) = 'foo'
plot.foo = function(myobj, col1 = 'red', col2 = 'blue', type = 'l', ...)
{
ylim = c(min(obj$y1, obj$y2), max(obj$y1, obj$y2))
plot(myobj$y1, type = type, col = col1, panel.first = grid(col = '#A9A9A9'), ylim = ylim, ...)
lines(myobj$y2, col = col2, type = type, ...)
}
plot(obj)
This looks good, but if i call
plot(obj, col = 'black')
It raises an error:
Error in plot.foo(obj, col = "black") :
argument 2 matches multiple formal arguments
Is there a way i can handle the 2 series + legends without breaking the plot protocol?
(another problem is to synch the legend lwd and pch parameters)
And will CRAN reject my package if i get ride of the ... arg?
Thanks!
You could have a vector expected called cols with no default. You can then add:
if(missing(cols)){
col1= "red"
col2 = "black"
} else {
col1=cols[1]
col2=cols[2]
}
There are surely better ways to do it but just thought I would throw this up.