I just learned how to insert (a limited number of) LaTeX expressions into my plot titles with
expression(<LaTeX code>). How can I generate plots containing LaTeX in their titles using a loop? For example, say I have:
par(mfrow = c(2,2))
x <- seq(1,10,0.1)
y <- sin(x)
plot(x, y, main = expression(sigma[1]))
plot(x, y, main = expression(sigma[2]))
This produces the desired output:
How can I achieve the same output, but by replacing the last two lines with a loop? I tried
par(mfrow = c(2,2))
for (i in 1:2){
plot(x, y, main = expression(sigma[i]))
}
but the i was not interpreted as a variable:
Any solutions for this?
We can use bquote instead of expression. This allows partial unquoting, meaning you can substitute the value of i inside the expression by wrapping it like this: .(i)
par(mfrow = c(2,2))
x <- seq(1,10,0.1)
y <- sin(x)
for(i in 1:4) plot(x, y, main = bquote(paste("My plot for ", sigma[.(i)], " :")))
Created on 2022-02-19 by the reprex package (v2.0.1)
par(mfrow = c(2,2))
loop.vector <- 1:2
for (i in loop.vector) {
x <- seq(1,10,0.1)
y <- sin(x)
plot(x, y, main = bquote(sigma[.(i)]))
}
Another option is substitute
for (i in 1:2){
plot(x, y, main = substitute(paste("My plot for ", sigma[i]), list(i = i)))
}
-output
For your reference, there is also tikzDevice, which actually generates .tex:
sigma <- 2^(1:4)
x <- seq(0, 2 * pi, 0.01 * pi)
tikzDevice::tikz("sine.tex", standAlone = TRUE)
par(mfrow = c(2L, 2L))
for (i in seq_along(sigma)) {
y <- sin(sigma[i] * x)
plot(x, y, type = "o", xlab = "$x$", ylab = "$y$",
main = sprintf("$y = \\sin(\\sigma_{%d} x)$", i))
}
dev.off()
tools::texi2dvi("sine.tex", pdf = TRUE)
system(paste(getOption("pdfviewer"), "sine.pdf"))
Related
The type of plot I am trying to achieve in R seems to have been known as either as moving distribution, as joy plot or as ridgeline plot:
There is already a question in Stackoverflow whose recorded answer explains how to do it using ggplot: How to reproduce this moving distribution plot with R?
However, for learning purposes, I am trying to achieve the same using only base R plots (no lattice, no ggplot, no any plotting package).
In order to get started, I generated the following fake data to play with:
set.seed(2020)
shapes <- c(0.1, 0.5, 1, 2, 4, 5, 6)
dat <- lapply(shapes, function(x) rbeta(1000, x, x))
names(dat) <- letters[1:length(shapes)]
Then using mfrow I can achieve this:
par(mfrow=c(length(shapes), 1))
par(mar=c(1, 5, 1, 1))
for(i in 1:length(shapes))
{
values <- density(dat[[names(dat)[i]]])
plot(NA,
xlim=c(min(values$x), max(values$x)),
ylim=c(min(values$y), max(values$y)),
axes=FALSE,
main="",
xlab="",
ylab=letters[i])
polygon(values, col="light blue")
}
The result I get is:
Clearly, using mfrow (or even layout) here is not flexible enough and also does allow for the overlaps between the distributions.
Then, the question: how can I reproduce that type of plot using only base R plotting functions?
Here's a base R solution. First, we calculate all the density values and then manually offset off the y axis
vals <- Map(function(x, g, i) {
with(density(x), data.frame(x,y=y+(i-1), g))
}, dat, names(dat), seq_along(dat))
Then, to plot, we calculate the overall range, draw an empty plot, and the draw the densities (in reverse so they stack)
xrange <- range(unlist(lapply(vals, function(d) range(d$x))))
yrange <- range(unlist(lapply(vals, function(d) range(d$y))))
plot(0,0, type="n", xlim=xrange, ylim=yrange, yaxt="n", ylab="", xlab="Value")
for(d in rev(vals)) {
with(d, polygon(x, y, col="light blue"))
}
axis(2, at=seq_along(dat)-1, names(dat))
d = lapply(dat, function(x){
tmp = density(x)
data.frame(x = tmp$x, y = tmp$y)
})
d = lapply(seq_along(d), function(i){
tmp = d[[i]]
tmp$grp = names(d)[i]
tmp
})
d = do.call(rbind, d)
grp = unique(d$grp)
n = length(grp)
spcx = 5
spcy = 3
rx = range(d$x)
ry = range(d$y)
rx[2] = rx[2] + n/spcx
ry[2] = ry[2] + n/spcy
graphics.off()
plot(1, type = "n", xlim = rx, ylim = ry, axes = FALSE, ann = FALSE)
lapply(seq_along(grp), function(i){
x = grp[i]
abline(h = (n - i)/spcy, col = "grey")
axis(2, at = (n - i)/spcy, labels = grp[i])
polygon(d$x[d$grp == x] + (n - i)/spcx,
d$y[d$grp == x] + (n - i)/spcy,
col = rgb(0.5, 0.5, 0.5, 0.5))
})
I have a chart created inside a couple of loops and I want to automatically write the chart to a file at the end of the outer loop. Here is a toy example:
filename <- "mychart"
for(i in 1:5) {
x <- 1:5
fun1 <- sample(1:10, 5, replace = TRUE)
xlim <- c(1, 5)
ylim <- c(0, 10)
plot(x, fun1, xlim = xlim, ylim = ylim, type = "l")
for(j in 1:3) {
fun2 <- 2:6 + j
lines(x, fun2, type = "l", col = "red")
}
out.filename <- paste(filename, i, sep = "")
## want to save this plot out to disk here!
}
I would also like to create the plot on the console so I can watch the program’s progress. Most answers to a similar question seem to deal with a plot that is created with a single “plot” statement, or do not enable the console plot window. Any suggestions much appreciated.
I think this does what you're after:
plotit <- function(i) {
x = 1:5
fun1 = sample(1:10, 5, replace=TRUE)
plot(x, fun1, xlim=c(1,5), ylim=c(0,10), type="l")
for(j in 1:3) {
fun2 = 2:6 + j
lines(x, fun2, type = "l", col = "red")
}
savePlot(paste0("mychart", i, ".png"), type="png")
}
Then:
for(i in seq(5)) plotit(i)
The typical way to save base graphics plots is with individual device functions such as pdf(), png(), etc. You open a plot device with the appropriate filename, create your plot, then close the device with dev.off(). It doesn't matter if your plot is created in a for loop or not. See lots of devices (and examples at the bottom) in ?png.
For your code, it would go something like this:
filename <- "mychart"
for(i in 1:5) {
out.filename <- paste(filename, i, ".png", sep = "")
## Open the device before you start plotting
png(file = out.filename)
# you can set the height and width (and other parameters) or use defaults
x <- 1:5
fun1 <- sample(1:10, 5, replace = TRUE)
xlim <- c(1, 5)
ylim <- c(0, 10)
plot(x, fun1, xlim = xlim, ylim = ylim, type = "l")
for(j in 1:3) {
fun2 <- 2:6 + j
lines(x, fun2, type = "l", col = "red")
}
## Close the device when you are done plotting.
dev.off()
}
I want to compare two datasets with same x and y variables. However, not all X variable points are present on both. As a toy example say this is what I have:
position.x <- c(1,2,3)
score.x <- c(450,220,330)
x <- data.frame(position,score.x)
position.y <- c(2,3,5)
score.y <- c(333,423,988)
y<- data.frame(position.y,score.y)
par(mfrow = c(2,1))
plot(x, pch = 19)
plot(y, pch = 19)
X axes are not comparable. I found some post explaining how to do it on ggplot using facet_wrap but I would like to do it using base graph.
Thank you in advance.
you could specify the range of the x and y axises by xlim and slim
position.x <- c(1,2,3)
score.x <- c(450,220,330)
x <- data.frame(position,score.x)
position.y <- c(2,3,5)
score.y <- c(333,423,988)
y<- data.frame(position.y,score.y)
par(mfrow = c(2,1))
plot(x, pch = 19, xlim=c(1,5))
plot(y, pch = 19, xlim=c(1,5))
if you are going to repeat this, you might as well write some kind of function (which is one of the benefits of ggplot--it takes care of all the set-up for you):
## data needs to be in a long format
dat <- data.frame(position = c(1,2,3,2,3,5),
score = c(450,220,330,333,423,988),
z = c('x','x','x','y','y','y'))
facet_wrap <- function(data, x, y, z, horiz = TRUE, ...) {
## save current par settings and return after finished
op <- par(no.readonly = TRUE)
on.exit(par(op))
zz <- unique(data[, z])
## sets up the layout to cascade horizontally or vertically
## and sets xlim and ylim appropriately
if (horiz) {
par(mfrow = c(1, length(zz)), ...)
ylim <- range(data[, y])
xlim <- NULL
} else {
par(mfrow = c(length(zz), 1), ...)
xlim <- range(data[, x])
ylim <- NULL
}
## make a subset of data for each unique by variable
## and draw a basic plot for each one
for (ii in zz) {
tmp <- data[data[, z] %in% ii, ]
plot(tmp[, x], tmp[, y], xlim = xlim, ylim = ylim)
}
}
facet_wrap(dat, 'position', 'score', 'z', mar = c(5,4,2,2))
facet_wrap(dat, 'position', 'score', 'z', mar = c(5,4,1,2), horiz = FALSE)
I am trying to visualize a curve for pollination distribution. I am very new to R so please don't be upset by my stupidity.
llim <- 0
ulim <- 6.29
f <- function(x,y) {(.156812/((2*pi)*(.000005^2)*(gamma(2/.156812)))*exp(-((sqrt(x^2+y^2))/.000005)^.156812))}
integrate(function(y) {
sapply(y, function(y) {
integrate(function(x) f(x,y), llim, ulim)$value
})
}, llim, ulim)
fv <- Vectorize(f)
curve(fv, from=0, to=1000)
And I get:
Error in y^2 : 'y' is missing
I'm not quite sure what you're asking to plot. But I know you want to visualise your scalar function of two arguments.
Here are some approaches. First we define your function.
llim <- 0
ulim <- 6.29
f <- function(x,y) {
(.156812/((2*pi)*(.000005^2)*(gamma(2/.156812)))*exp(-((sqrt(x^2+y^2))/.000005)^.156812))
}
From your title I thought of the following. The function defined below intf integrates your function over the square [0,ul] x [0,ul] and return the value. We then vectorise and plot the integral over the square as a function the length of the side of the square.
intf <- function(ul) {
integrate(function(y) {
sapply(y, function(y) {
integrate(function(x) f(x,y), 0, ul)$value
})
}, 0, ul)$value
}
fv <- Vectorize(intf)
curve(fv, from=0, to=1000)
If f is a distribution, I guess you can make your (somewhat) nice probability interpretation of this curve. (I.e. ~20 % probability of pollination(?) in the 200 by 200 meter square.)
However, you can also do a contour plot (of the log-transformed values) which illustrate the function we are integrating above:
logf <- function(x, y) log(f(x, y))
x <- y <- seq(llim, ulim, length.out = 100)
contour(x, y, outer(x, y, logf), lwd = 2, drawlabels = FALSE)
You can also plot some profiles of the surface:
plot(1, xlim = c(llim, ulim), ylim = c(0, 0.005), xlab = "x", ylab = "f")
y <- seq(llim, ulim, length.out = 6)
for (i in seq_along(y)) {
tmp <- function(x) f(x, y = y[i])
curve(tmp, llim, ulim, add = TRUE, col = i)
}
legend("topright", lty = 1, col = seq_along(y),
legend = as.expression(paste("y = ",y)))
They need to be modified a bit to make them publication worthy, but you get the idea. Lastly, you can do some 3d plots as others have suggested.
EDIT
As per your comments, you can also do something like this:
# Define the function times radius (this time with general a and b)
# The default of a and b is as before
g <- function(z, a = 5e-6, b = .156812) {
z * (b/(2*pi*a^2*gamma(2/b)))*exp(-(z/a)^b)
}
# A function that integrates g from 0 to Z and rotates
# As g is not dependent on the angle we just multiply by 2pi
intg <- function(Z, ...) {
2*pi*integrate(g, 0, Z, ...)$value
}
# Vectorize the Z argument of intg
gv <- Vectorize(intg, "Z")
# Plot
Z <- seq(0, 1000, length.out = 100)
plot(Z, gv(Z), type = "l", lwd = 2)
lines(Z, gv(Z, a = 5e-5), col = "blue", lwd = 2)
lines(Z, gv(Z, b = .150), col = "red", lwd = 2)
lines(Z, gv(Z, a = 1e-4, b = .2), col = "orange", lwd = 2)
You can then plot the curves for the a and b you want. If either is not specified, the default is used.
Disclaimer: my calculus is rusty and I just did off this top of my head. You should verify that I've done the rotation of the function around the axis properly.
The lattice package has several functions that can help you draw 3 dimensional plots, including wireframe() and persp(). If you prefer not to use a 3d-plot, you can create a contour plot using contour().
Note: I don't know if this is intentional, but your data produces a very large spike in one corner of the plot. This produces a plot that is for all intents flat, with a barely noticable spike in one corner. This is particularly problematic with the contour plot below.
library(lattice)
x <- seq(0, 1000, length.out = 50)
y <- seq(0, 1000, length.out = 50)
First the wire frame plot:
df <- expand.grid(x=x, y=y)
df$z <- with(df, f(x, y))
wireframe(z ~ x * y, data = df)
Next the perspective plot:
dm <- outer(x, y, FUN=f)
persp(x, y, dm)
The contour plot:
contour(x, y, dm)
I know I can use panel.xyarea from latticeExtra to fill the area in the plot with any colour. Without defining a type argument in xyplot, such filling will follow the route of default type="p":
library(lattice)
library(latticeExtra)
data <- data.frame(time=1:24,value=rnorm(24))
xyplot(value~time, data,
panel=function(x,y,...){
panel.xyarea(x,y,...)
panel.xyplot(x,y,...)})
This plots both panel.xyarea and the points coming from default type="p" in panel.xyplot. Now the problem arise when I want to change the type of plotting line, for example making it step function type="S":
xyplot(value~time, data, type="S",
panel=function(x,y,...){
panel.xyarea(x,y,...)
panel.xyplot(x,y,...)}
As you see on the example above, panel.xyarea doesn't fill the area underneath the new step function, but instead it plots both areas overlapping. It doesn't change anything if I move type="S" to the panel.xyarea - in fact it doesn't register type argument it at all and plots as it wouldn't be there.
Is there a way I can bypass this and have panel.xyarea fill my plots whatever type I define - be it step function (type="S"), loess (type="smooth") or regression (type="r")? Or maybe there is something better than panel.xyarea to use in such context?
For each value of type, you'll need to construct a custom panel function. Fortunately, if you model the functions closely on existing lattice code (starting out by having a look at panel.xyplot), that shouldn't be too hard. For example, the two custom panel functions below include many lines of code but only a couple of lines (marked with comments) that I had to write.
Once you've defined the panel functions (copying them in from the code blocks following the figure), use them like this:
library(lattice)
library(latticeExtra)
library(gridExtra)
set.seed(100)
data <- data.frame(time=1:24,value=rnorm(24))
## Filled version of xyplot(..., type="S")
a <- xyplot(value~time, data, panel=panel.filled_S)
## Filled version of xyplot(..., type="smooth")
b <- xyplot(value~time, data, panel=panel.filled_smooth)
grid.arrange(a, b, ncol = 2)
For a filled version of type="S":
## Modeled on code in panel.xyplot, which is called when type=S"
panel.filled_S <-
function(x,y, ...) {
horizontal <- FALSE ## Edited (may not want to hardcode)
ord <- if (horizontal)
sort.list(y)
else sort.list(x)
n <- length(x)
xx <- numeric(2 * n - 1)
yy <- numeric(2 * n - 1)
xx[2 * 1:n - 1] <- x[ord]
yy[2 * 1:n - 1] <- y[ord]
xx[2 * 1:(n - 1)] <- x[ord][-n]
yy[2 * 1:(n - 1)] <- y[ord][-1]
panel.xyarea(x = xx, y = yy, ...) ## Edited
panel.lines(x = xx, y = yy, ...) ## Edited
}
xyplot(value~time, data, panel=panel.filled_S, type="o")
For a filled version of type="smooth":
## Modeled on code in panel.loess, called by panel.xyplot when type="smooth"
panel.filled_smooth <-
function (x, y, span = 2/3, degree = 1, family = c("symmetric",
"gaussian"), evaluation = 50, lwd = plot.line$lwd, lty = plot.line$lty,
col, col.line = plot.line$col, type, horizontal = FALSE,
..., identifier = "loess")
{
x <- as.numeric(x)
y <- as.numeric(y)
ok <- is.finite(x) & is.finite(y)
if (sum(ok) < 1)
return()
if (!missing(col)) {
if (missing(col.line))
col.line <- col
}
plot.line <- trellis.par.get("plot.line")
if (horizontal) {
smooth <- loess.smooth(y[ok], x[ok], span = span, family = family,
degree = degree, evaluation = evaluation)
panel.lines(x = smooth$y, y = smooth$x, col = col.line,
lty = lty, lwd = lwd, ..., identifier = identifier)
panel.xyarea(smooth$y, smooth$x, ...) ## Edited
}
else {
smooth <- loess.smooth(x[ok], y[ok], span = span, family = family,
degree = degree, evaluation = evaluation)
panel.lines(x = smooth$x, y = smooth$y, col = col.line,
lty = lty, lwd = lwd, ..., identifier = identifier)
panel.xyarea(smooth$x, smooth$y, ...) ## Edited
}
smooth
}