Is there a way to interactively and sequentially add more ggplots onto a plotting window, similar to how in base you can add more plots by using par(mfrow = ...). E.g. (for loop to simulate sequentially entering plot commands):
par(mfrow = c(4, 1))
for (i in 1:4) {
plot(tmp_df$x, tmp_df$y)
}
produces, sequentially, the first to the last row of the following plot:
Whereas, doing the same with ggplot just prints one plot to the plot window:
par(mfrow = c(4, 1))
for (i in 1:4) {
plot(ggplot(tmp_df, aes(x, y)) +
geom_point())
}
I already know how to use gridExtra::grid.arrange to arrange a list of ggplots, e.g.:
tmp_list <- list()
for (i in 1:4) {
tmp_list[[length(tmp_list) + 1]] <-
ggplot(tmp_df, aes(x, y)) +
geom_point()
}
gridExtra::grid.arrange(grobs = tmp_list, nrow = 4)
You can certainly add one plot at a time e.g by making a grid layout and drawing in specific viewports sequentially,
library(grid)
library(ggplot2)
gl <- replicate(4, ggplot(), F)
par <- function(mfrow = c(2,2)) pushViewport(viewport(layout = grid.layout(mfrow[1], mfrow[2])))
print.gg <- function(x) {
rc <- which(matrix(1:4, 2, 2) == ii, arr.ind = TRUE)
ggplot2:::print.ggplot(x, vp=viewport(layout.pos.row = rc[1,1], layout.pos.col = rc[1,2]))
ii <<- (ii+1)%%4
}
grid.newpage()
par()
for(ii in seq_along(gl))
print(gl[[ii]])
Here's a version with a gtable layout keeping track of occupied cells,
library(grid)
library(ggplot2)
library(gtable)
par <- function(mfrow=c(2,2)) {
nr <- mfrow[1]; nc <- mfrow[2]
.g_layout <<- gtable(widths = unit(rep(1/nc, nc), "npc"), heights = unit(rep(1/nr, nr), "npc"))
}
print.gg <- function(x) {
ntot <- prod(dim(.g_layout))
ii <- (length(.g_layout) + 1) %% (ntot+1)
rc <- which(matrix(seq_len(ntot), nrow = nrow(.g_layout), ncol = ncol(.g_layout)) == ii, arr.ind = TRUE)
.g_layout <<- gtable::gtable_add_grob(.g_layout, ggplotGrob(x), t = rc[1,1], l = rc[1,2])
grid.newpage()
grid.draw(.g_layout)
}
gl <- replicate(4, ggplot(), F)
par()
for(ii in seq_along(gl))
print(gl[[ii]])
Related
I am plotting contour plots using ggplot in loop. I have few concerns -
the color levels are different in all iterations, how do it keep it steady iterations?
the number and range of levels are also changing with iteration, how to keep it constant across iterations ?
the length occupied by color scale is much longer than actual figure. How do I adjust that ?
How do I manually set the levels of colors in contours?
I have attached a sample below. Can someone please edit in the same code with comments
library(tidyverse)
library(gridExtra)
library(grid)
# data generation
x <- seq(-10, 10, 0.2)
y <- seq(-10, 10, 0.2)
tbl <- crossing(x, y)
for (i in seq(1, 2)) # to create two sample plots
{
# initialize list to store subplots
p <- list()
for (j in seq(1, 3)) # to create 3 subplots
{
# for randomness
a <- runif(1)
b <- runif(1)
# add z
tbl <- tbl %>%
mutate(z = a*(x - a)^2 + b*(y - b)^2)
# plot contours
p[[j]] <- ggplot(data = tbl,
aes(x = x,
y = y,
z = z)) +
geom_contour_filled(alpha = 0.8) +
theme_bw() +
theme(legend.position = "right") +
theme(aspect.ratio = 1) +
ggtitle("Sample")
}
p <- grid.arrange(p[[1]], p[[2]], p[[3]],
ncol = 3)
ggsave(paste0("iteration - ", i, ".png"),
p,
width = 8,
height = 3)
}
The actual plots are subplot for another plot, so I can increase its size. Therefore, width and height cannot be increased in ggsave.
Thanks
You can set breaks in geom_contour_filled. You can change your pngs by doubling their size but halfing their resolution. They will remain the same in terms of pixel dimensions.
for (i in seq(1, 2)) # to create two sample plots
{
p <- list()
for (j in seq(1, 3)) # to create 3 subplots
{
# for randomness
a <- runif(1)
b <- runif(1)
tbl <- tbl %>%
mutate(z = a*(x - a)^2 + b*(y - b)^2)
p[[j]] <- ggplot(data = tbl,
aes(x = x,
y = y,
z = z)) +
geom_contour_filled(alpha = 0.8, breaks = 0:9 * 20) +
scale_fill_viridis_d(drop = FALSE) +
theme_bw() +
theme(legend.position = "right") +
theme(aspect.ratio = 1) +
ggtitle("Sample")
}
p <- grid.arrange(p[[1]], p[[2]], p[[3]],
ncol = 3)
ggsave(paste0("iteration - ", i, ".png"),
p,
width = 16,
height = 6,
dpi = 150)
}
iteration-1.png
iteration-2.png
I wonder how can I find the control points of geom_curve in ggplot2? e.g.
p <- ggplot(mtcars, aes(wt, mpg)) +
geom_curve(aes(x = 2.62, y = 21.0, xend = 3.57, yend = 15.0),curvature = -0.2, data = df) +
geom_point()
b <- ggplot_build(p)
b$data[[1]]
p$layers[[1]]$geom_params
b$data[[1]] gives the starting and ending points and p$layers[[1]]$geom_params gives the curve information (angle, curvature, ...).
But how can I find the control points, so I can reproduce the graphics?
library(ggplot)
library(grid)
library(stringr)
df <- data.frame(x = 1:3, y = 1:3)
df2 <- data.frame(x = c(1,3), y = c(1,3),
xend = c(2,2), yend = c(2,2))
g <- ggplot(df, aes(x, y)) +
geom_point() +
geom_curve(aes(x = x ,y = y,
xend = xend, yend = yend),
data = df2,
color = c("red", "blue"))
g
getCurve_controlPoints <- function(ggplotObject) {
len_layers <- length(ggplotObject$layers)
layerNames <- lapply(seq_len(len_layers),
function(j) {
className <- class(ggplotObject$layers[[j]]$geom)
className[-which(className %in% c("ggproto" ,"gg", "Geom"))]
})
curveLayerId <- which(sapply(layerNames,
function(layerName){
"GeomCurve" %in% layerName
}) == TRUE
)
gg_build <- ggplot_build(ggplotObject)
# you can also add yes or no in your code
# answer <- utils::menu(c("y", "n"), title="Do you want to draw the ggplot?")
grid.draw(ggplotObject)
grid.force()
gridList <- grid.ls(print = FALSE)
gridList.name <- gridList$name
xspline.name <- gridList.name[which(str_detect(gridList.name, "curve") == TRUE)]
xspline.len <- length(xspline.name)
controlPoints <- lapply(seq_len(length(curveLayerId)),
function (j) {
# curve data
curve_data <- gg_build$data[[curveLayerId[j]]]
# avoid duplicated rows
curve_data <- curve_data[!duplicated(curve_data), ]
n <- dim(curve_data)[1]
# here we go! But wait a second, it seems like the starting and ending position do not match
xsplinePoints <- xsplinePoints(grid.get("xspline", grep=TRUE))
# mapping data to our coordinates
control_data <- lapply(seq_len(n),
function(i){
if (n == 1) {
xy <- lapply(xsplinePoints,
function(coord){
as.numeric(coord)
})
} else {
xy <- lapply(xsplinePoints[[i]],
function(coord){
as.numeric(coord)
})
}
x.start <- curve_data[i, ]$x
x.end <- curve_data[i, ]$xend
y.start <- curve_data[i, ]$y
y.end <- curve_data[i, ]$yend
# mapping to ggplot coordinates
xy_x.diff <- xy$x[length(xy$x)] - xy$x[1]
xy_y.diff <- xy$y[length(xy$y)] - xy$y[1]
# maybe there is a better way?
if(xy_x.diff == 0){
xy_x.diff <- 1e-16
}
if(xy_y.diff == 0){
xy_y.diff <- 1e-16
}
x <- (x.end - x.start) / (xy_x.diff) * (xy$x - xy$x[1]) + x.start
y <- (y.end - y.start) / (xy_y.diff) * (xy$y - xy$y[1]) + y.start
list(x = x, y = y)
})
# grid remove
grid.remove(xspline.name[j], redraw = FALSE)
control_data
})
controlPoints
}
controlPoints <- getCurve_controlPoints(g)
# check the points
plot(controlPoints[[1]][[1]]$x, controlPoints[[1]][[1]]$y,
xlim = c(1,3),
ylim = c(1,3),
xlab = "x",
ylab = "y",
pch = 19)
points(controlPoints[[1]][[2]]$x, controlPoints[[1]][[2]]$y, pch = 19)
I think it works well so far and the ggplot version I used is 3.0.0. If you use any version less than 2.2.1, error may occur.
This idea is suggested by Prof Paul Murrell. Perhaps the easiest way to capture the control points of geom_curve? The cons are that grobs(ggplot object) must be drawn at first, since these points are only generated at the drawing time.
I am using the hclust function:
points <- data.frame(ID = c('A','B','C','D','E'),
x = c(3,4,2.1,4,7),
y = c(6.1,2,5,6,3))
d <- dist(as.matrix(points[, 2:3]))
clusters <- hclust(d,method = "complete")
plot(clusters, labels=points$ID)
Is there a way to show the values where the points are joined (or the node values (where the dissimilarity between the samples is minimal))?
I want my plot to look like the one on the picture.
Note: The values showed on the dendrogram are not the correct ones.
My R package TBEST has a function that can add two color annotations to a hclust object. For your convenience, I am pasting codes below, so you can use them independent of any packages.
hc2axes<-function (x) {
A <- x$merge
n <- nrow(A) + 1
x.axis <- c()
y.axis <- x$height
x.tmp <- rep(0, 2)
zz <- match(1:length(x$order), x$order)
for (i in 1:(n - 1)) {
ai <- A[i, 1]
if (ai < 0)
x.tmp[1] <- zz[-ai]
else x.tmp[1] <- x.axis[ai]
ai <- A[i, 2]
if (ai < 0)
x.tmp[2] <- zz[-ai]
else x.tmp[2] <- x.axis[ai]
x.axis[i] <- mean(x.tmp)
}
return(data.frame(x.axis = x.axis, y.axis = y.axis))
}
plot_height<-function (hc, height, col = c(2, 3), print.num = TRUE, float = 0.01, cex = NULL, font = NULL)
{
axes <- hc2axes(hc)
usr <- par()$usr
wid <- usr[4] - usr[3]
bp <- as.character(round(height,2))
rn <- as.character(1:length(height))
bp[length(bp)] <- "height"
rn[length(rn)] <- "edge #"
a <- text(x = axes[, 1], y = axes[, 2] + float * wid, bp,
col = col[1], pos = 2, offset = 0.3, cex = cex, font = font)
if (print.num) {
a <- text(x = axes[, 1], y = axes[, 2], rn, col = col[2],
pos = 4, offset = 0.3, cex = cex, font = font)
}
}
Once you paste these two functions, add one line to plot your dendrogram,
plot(clusters,labels=points$ID);
cluster_height(clusters,height=clusters$height,print.num=F)
You can also plot the branch numbers by setting print.num=T
Here's one method using the dendextend package.
First, convert to hanging dendrogram
library(dendextend)
dend <- as.dendrogram(clusters) %>% hang.dendrogram()
dend <- dend %>% set_labels(points$ID[dend %>% labels()])
Now we find the x,y values for all the internal nodes
xy <- dend %>% get_nodes_xy()
is_internal_node <- is.na(dend %>% get_nodes_attr("leaf"))
is_internal_node[which.max(xy[,2])] <- FALSE
xy <- xy[is_internal_node,]
And now we plot the dendrogram and draw the labels at a slight offset
plot(dend)
text(xy[,1]+.2, xy[,2]+.2, labels=format(xy[,2], digits=2), col="red")
This gives the following plot
I'm working inside a loop and I'd like to save plots in a list so I can plot them together in a .pdf. The problem is that the list is not filled up properly and re-updates with the results of the last run. So, in the end what I get is a list with five elements that are exactly the same.
I'm aware the loops may seem useless, but I just have them to create a test code (with a reproducible error) as close to the real one as possible. So, I need to leave the loops as they are.
library (ggplot)
library (gridExtra)
plist <- list()
for (z in 1:5){
n <- 100
k <- seq(0, to=4500+z*2000, length=n)
tmp <- numeric(n)
for (i in 1:n){
tmp[i] <- (5*(i*3)^2)}
plist[[z]] <- ggplot() +
geom_line(aes(x = k, y = tmp)) +
theme_bw()
pdf(sprintf("p%s.pdf", z),
width = 6, height = 4, onefile = T)
plot(plist[[z]])
dev.off()
}
do.call(grid.arrange, c(plist, ncol = 5))
This answer is based on: Storing plot objects in a list
library(ggplot2)
library(gridExtra)
plist <- list()
for (z in 1:5){
n <- 100
k <- seq(0, to=4500+z*2000, length=n)
tmp <- numeric(n)
for (i in 1:n){
tmp[i] <- (5*(i*3)^2)}
data <- data.frame(n, k, tmp)
plist[[z]] <- ggplot(data = data) + #data needs to be given!!
geom_line(aes(x = k, y = tmp)) +
theme_bw()
pdf(sprintf("p%s.pdf", z),
width = 6, height = 4, onefile = T)
plot(plist[[z]])
dev.off()
}
do.call(grid.arrange, c(plist, ncol = 5))
I have a viewport with two graphs drawn in a left to right fashion. I'm trying to have a single title appear over both of the graphs centered in the viewport. Is this possible? Sorry, no pic because of my noob status and I can't post the code because of my work environment.
I think you might be interested in the gridExtra package, which provides the grid.arrange() function that fulfills everything you wonder about.
With #Kevin's example, the command would be
grid.arrange(plots[[1]], plots[[2]], ncol=2,
main="test main", sub="subtitle test")
I have been using an almost unmodified version of code in this post to the ggplot2 mailing list to put a main title and subtitle above and below a matrix of plots. Credit to Baptiste Auguié.
arrange <- function(..., nrow=NULL, ncol=NULL, as.table=FALSE,
main=NULL, sub=NULL, plot=TRUE) {
dots <- list(...)
n <- length(dots)
if(is.null(nrow) & is.null(ncol)) { nrow = floor(n/2) ; ncol = ceiling(n/nrow)}
if(is.null(nrow)) { nrow = ceiling(n/ncol)}
if(is.null(ncol)) { ncol = ceiling(n/nrow)}
fg <- frameGrob(layout=grid.layout(nrow,ncol))
ii.p <- 1
for(ii.row in seq(1, nrow)){
ii.table.row <- ii.row
if(as.table) {ii.table.row <- nrow - ii.table.row + 1}
for(ii.col in seq(1, ncol)){
ii.table <- ii.p
if(ii.p > n) break
fg <- placeGrob(fg, ggplotGrob(dots[[ii.table]]),
row=ii.table.row, col=ii.col)
ii.p <- ii.p + 1
}
}
if(!is.null(main) | !is.null(sub)){
g <- frameGrob() # large frame to place title(s) and content
g <- packGrob(g, fg)
if (!is.null(main))
g <- packGrob(g, textGrob(main), side="top")
if (!is.null(sub))
g <- packGrob(g, textGrob(sub), side="bottom")
} else {
g <- fg
}
if(plot) grid.draw(g)
invisible(g)
}
library(ggplot2)
plots <- llply(1:2, function(.x) qplot(1:10,rnorm(10), main=paste("plot",.x)))
arrange(plots[[1]],plots[[2]], nrow=1, ncol = 2, as.table=TRUE, main="test main",
sub="subtitle test")
Produces:
Another Possibility, it's kind of cheating by way of creating a blank plot...
p1 <- ggplot(diamonds, aes(price,depth)) + geom_point()
p2 <- ggplot(diamonds, aes(price,carat)) + geom_point()
p3 <- ggplot(diamonds, aes(x=1,y=1,label="Title")) + geom_text(size=20) + opts(panel.background=theme_blank(), panel.grid.minor=theme_blank(), panel.grid.major=theme_blank(), axis.text.x=theme_blank(), axis.text.y=theme_blank(), axis.ticks=theme_blank(), axis.title.x=theme_blank(), axis.title.y=theme_blank())
vplayout <- function(x, y) viewport(layout.pos.row=x, layout.pos.col=y)
grid.newpage()
pushViewport(viewport(layout=grid.layout(4,4)))
print(p1,vp=vplayout(2:4,1:2))
print(p2,vp=vplayout(2:4,3:4))
print(p3,vp=vplayout(1,1:4))