this is a simple example I have, where I generate 5 standard normals, each one with his own p value (just for the sake of the demonstration). I save that in a 4x50x5 array called X.
After that, I want to save 5 plots with 4 histograms each in a .pdf, and the following code does the job
pvec <- 2^(2:5)
n <- pvec/2
j <- 5
size <- 50
X <- array(rep(NA, length(pvec)*reps*j), dim=c(length(pvec), reps, j))
for (k in 1:length(pvec)){
for (i in 1:j){
X[k,,i] <- rnorm(size)
}
}
pdf("grafic.pdf")
par(mfrow=c(2,2))
for (w in 1:j){
for (k in 1:length(pvec)){
hist(X[k,,w], freq = F, col = 'lightgreen',main = paste("p = ", pvec[k], ",n =", n[k]))
curve(dnorm(x,mean=0,sd=1), add=TRUE,col="blue")
}
}
dev.off()
Obtaining, for example
Let's say that I want to do this now, but with ggplot. I have to use ggarrange in replace of par(mfrow). But ggarrange uses a plot.list as an argument, so inside the for I should have something like
graphlist <- NULL
for (w in 1:j){
for (k in 1:length(p.vec)){
graphlist[k,,w] <- ggplot(data=data.frame(X), aes(x=X[k,,w])) +
geom_histogram()
}
}
ggarrange(plotlist = graphlist, ncol = 2, nrow = 2)
But of course this doesn't work. How can I do stuffs like that, where I need to save the plots made by ggplot2 and then combine them with ggarrange? Thanks
Related
I'm wondering if there is a way to remove the tickmarks (the axes) on the 3rd and 4th axes of the plot generated by library effects as shown below?
library(effects)
m <- lm(Fertility ~ ., data = swiss)
plot(allEffects(m), rug = FALSE)
It doesn't look like the package authors choose to expose that propertly very easily. We could write our own version of plot.efflist which is doing most of the work here. Here's the alternative version
plot.efflist <- function (x, selection, rows, cols, graphics = TRUE,
lattice, ...)
{
lattice <- if (missing(lattice))
list()
else lattice
if (!missing(selection)) {
if (is.character(selection))
selection <- gsub(" ", "", selection)
pp <- plot(x[[selection]], lattice = lattice, ...)
pp$x.scales$tck=c(1,0)
pp$y.scales$tck=c(1,0)
return(pp)
}
effects <- gsub(":", "*", names(x))
neffects <- length(x)
mfrow <- mfrow(neffects)
if (missing(rows) || missing(cols)) {
rows <- mfrow[1]
cols <- mfrow[2]
}
for (i in 1:rows) {
for (j in 1:cols) {
if ((i - 1) * cols + j > neffects)
break
more <- !((i - 1) * cols + j == neffects)
lattice[["array"]] <- list(row = i, col = j,
nrow = rows, ncol = cols, more = more)
pp <- plot(x[[(i - 1) * cols + j]], lattice = lattice,
...)
# hack to turn off opposite side tick marks
pp$x.scales$tck=c(1,0)
pp$y.scales$tck=c(1,0)
print(pp)
}
}
}
environment(plot.efflist) <- asNamespace("effects")
Basically we just call the plot.eff function as is, then modify the result to turn off the second set of ticks before plotting.
This returns
plot(allEffects(m), rug = FALSE)
Optionally you could try this approach as well
plot.eff <- function(...) {
pp <- effects:::plot.eff(...)
pp$x.scales$tck=c(1,0)
pp$y.scales$tck=c(1,0)
pp
}
environment(plot.eff) <- asNamespace("effects")
helpenv <- new.env(parent = asNamespace("effects"))
helpenv$plot.eff <- plot.eff
plot.efflist <- effects:::plot.efflist
environment(plot.efflist) <- helpenv
Here, rather than changing just the function that operators on efflist objects, we change the behavior for all eff objects. We do the rewrite but then also need to change the efflist version to find our new version first. This method keeps us from having to repeat any logic from these functions, but it does mean we make a bit of a mess with environments.
The my simple case:
Plotting graphs within the loop brings different results than plotting it directly after the loop
# Initialize
Input <- list(c(3,3,3,3),c(1,1,1,1))
y <- c()
x <- c()
plotlist <- c()
Answer <- c()
# create helper grid
x.grid = c(1:4)
y.grid = c(1:4)
helpergrid <- expand.grid(xgrid=x.grid, ygrid=y.grid )
#- Loop Lists -
for (m in c(1,2))
{
# # Loop within each list
# for(j in 1:4)
# {
# y[j] <- Input[[m]][j]
# x[j] <- j
# }
y[1] <- Input[[m]][1]
x[1] <- 1
y[2] <- Input[[m]][2]
x[2] <- 2
y[3] <- Input[[m]][3]
x[3] <- 3
y[4] <- Input[[m]][4]
x[4] <- 4
Points <- data.frame(x, y)
# Example Plot
plot = ggplot() + labs(title = paste("Loop m = ",m)) + labs(subtitle = paste("y-values = ",Points$y)) + geom_tile(data = helpergrid, aes(x=xgrid, y=ygrid, fill=1), colour="grey20") + geom_point(data = Points, aes(x=Points$x, y=Points$y), stroke=3, size=5, shape=1, color="white") + theme_minimal()
# Plot to plotlist
plotlist[[m]] <- plot
# --- Plot plotlist within loop ---
plot(plotlist[[m]])
}
# --- Plot plotlist outside of loop ---
plot(plotlist[[1]])
plot(plotlist[[2]])
Here is an image of the results:
Plot Results
as aaumai is pointing out that there is a nested loop that might cause the issue for ggplot using static values, however the resulting plot 'is' showing the correct y-value (y=3) explicitely, but the geom_points are using the wrong values (y=1)...
It makes absolutely (!) no sense to me, I am relatively new to R and trying to debug this for hours now - so I hope someone can help me with this !!
EDIT: I manually removed the nested loop and updated the example code, but the problem still persists :(
The problem arises due to your use of Points$x within aes. The "tl;dr" is that basically you should never use $ or [ or [[ within aes. See the answer here from baptiste.
library(ggplot2)
# Initialize
Input <- list(c(3,3,3,3),c(1,1,1,1))
y <- c()
x <- c()
plotlist <- c()
Answer <- c()
# create helper grid
x.grid = c(1:4)
y.grid = c(1:4)
helpergrid <- expand.grid(xgrid=x.grid, ygrid=y.grid )
#- Loop Lists -
for (m in c(1,2)) {
y[1] <- Input[[m]][1]
x[1] <- 1
y[2] <- Input[[m]][2]
x[2] <- 2
y[3] <- Input[[m]][3]
x[3] <- 3
y[4] <- Input[[m]][4]
x[4] <- 4
Points <- data.frame(x, y)
# Example Plot
plot = ggplot() + labs(title = paste("Loop m = ",m)) + labs(subtitle = paste("y-values = ",force(Points$y))) +
geom_tile(data = helpergrid, aes(x=xgrid, y=ygrid, fill=1), colour="grey20") +
geom_point(data = Points, aes(x=x, y=y), stroke=3, size=5, shape=1, color="white") + theme_minimal()
# Plot to plotlist
plotlist[[m]] <- plot
# --- Plot plotlist within loop ---
print(plotlist[[m]])
}
# --- Plot plotlist outside of loop ---
print(plotlist[[1]])
print(plotlist[[2]])
I believe the reason this happens is due to lazy evaluation. The data passed into geom_tile/point gets stored, but when the plot is printed, it grabs Points$x from the current environment. During the loop, this points to the current state of the Points data frame, the desired state. After the loop is finished, only the second version of Points exists, so when the referenced value from aes is evaluated, it grabs the x values from Points$x as it exists after the second evaluation of the loop. Hope this is clear, feel free to ask further if not.
To clarify, if you remove Points$ and just refer to x within aes, it takes these values from the data.frame as it was passed into the data argument of the geom calls.
If I'm not mistaken, this is because you have a loop within the loop.
The plot within the loop returns plots for changing y values in the Points data (from 1 to 4), whereas the plot outside is only plotting the static values.
I couldn't found anything on this task while Googling, but I can't imagine no one has thought of doing this. Is there a way to generate random 2d data in the form of a letter of choice? So basically a function letter_random_data(letter) that would output x and y coordinates (within some boundaries) that together with some noise form the chosen letter.
Here's one way to do it: Draw an image containing the letter (or text, more generally). Read the image into an array, and use it to accept or reject points drawn randomly in the box holding the image.
For example,
library(png)
getTextImage <- function(text) {
filename <- tempfile()
png(filename = filename)
plot.new()
cex <- 1
repeat {
if (strwidth(text, cex = 2*cex) > 1) break
if (strheight(text, cex = 2*cex) > 1) break
cex <- 2*cex
}
text(0.5, 0.5, text, cex = cex)
dev.off()
image <- readPNG(filename)
unlink(filename) # clean up file
if (length(dim(image)) == 3)
image <- image[,,1] # just keep one channel
image
}
randomText <- function(n, text) {
image <- getTextImage(text)
nx <- dim(image)[1]
ny <- dim(image)[2]
hits <- 0
x <- y <- numeric(n)
while (hits < n) {
tryx <- runif(1)
tryy <- runif(1)
keep <- image[round((nx-1)*tryx + 1), round((ny-1)*tryy + 1)] == 0
if (keep) {
hits <- hits + 1
# Need to rotate so it looks good
x[hits] <- tryy
y[hits] <- 1 - tryx
}
}
cbind(x, y)
}
plot(randomText(1000, "Hello"))
This produces the following plot:
Is it possible to store a simple plot created using plot() in an R object?
Let's say I create a plot:
a<-rnorm(1000)
b<-rnorm(1000)
plot(a,type='b')
lines(b,col="blue")
I would like to store both the plot and the added line in an object.
Is this possible to do?
Something like that will save your plots in a list.
n <- 3
templist <- vector(mode = "list", n)
for(i in seq_along(templist)){
a <- rnorm(1000)
b <- rnorm(1000)
plot(a, type = 'b')
lines(b,col = "blue")
templist[[i]] <- recordPlot()
}
You can check each plot, by doing templist[[i]] where i is in the range of: 1 <= i <= n
I am making flow plots for spatial interation models, with x-y coordinates for both origins and destinations:
The problem is that I keep using nested for loops (one for origins, one for destinations) to plot these lines and am sure there's a better way in R.
Anyway to help answer this question I set-up a simple reproducible example with 4 origins and 2 destinations. Suspect the answer to plotting quicker is in matrix algebra, but not sure where to start. Test it out and please let me know:
o <- data.frame(x = c(3,5,6,1), y = c(8,2,3,2))
plot(o)
d <- data.frame(x = c(5,3), y = c(5,3))
points(d, col="red", pch=3)
beta <- 0.6
dist <- matrix(sqrt(c(o[,1] - d[1,1], o[,1] - d[2,1] )^2 +
c(o[,2] - d[1,2], o[,2] - d[2,2] )^2), ncol = 2)
s <- dist
for(i in 1:nrow(o)){
for(j in 1:nrow(d)){
s[i,j] <- exp(-beta * dist[i,j])
}
}
for(i in 1:nrow(o)){
for(j in 1:nrow(d)){
lines(c(o[i,1], d[j,1]), c(o[i,2], d[j,2]),
lwd = 2 * s[i,j] / mean(s))
}
}
Edit - for some context on this project, please see here http://rpubs.com/RobinLovelace/9697
A way to replace the second loop is to use mapply:
fun <- function(row.o, row.d)
{
lines(c(o[row.o,1], d[row.d,1]), c(o[row.o,2], d[row.d,2]),
lwd = 2 * s[row.o,row.d] / mean(s))
}
#all combinatios of rows of `d` and `o`
args.od <- expand.grid(1:nrow(o), 1:nrow(d))
mapply(fun, row.o = args.od[,1], row.d = args.od[,2])
The plot: