expanding table with gridExtra - r

How do increase the size of the table so that it take up all of the available space in..i.e so there's no white space.
Also- how do you remove row names of the table?
Thank you
dat = data.frame(x = c(1,2,4), y = c(12,3,5),z = c(5,6,7))
p =ggplot(dat, aes(x=x, y = y))+geom_point()+geom_line()
library(gridExtra)
t = tableGrob(dat)
rownames(t) =NULL
t$widths <- unit(rep(1/ncol(t), ncol(t)), "npc")
grid.arrange(t, p,p,nrow = 1)

I updated your code. The important parts are the rows = NULL option to tableGrob and the setting of t$heights. You probably need to tweak this to get something to your taste.
library(gridExtra)
library(ggplot2)
dat <- data.frame(x = c(1, 2, 4), y = c(12, 3, 5), z = c(5, 6, 7))
p <- ggplot(dat, aes(x = x, y = y)) +
geom_point() +
geom_line()
t <- tableGrob(dat, rows = NULL) # notice rows = NULL
t$widths <- unit(rep(1 / ncol(t), ncol(t)), "npc")
t$heights <- unit(rep(1 / nrow(t), nrow(t)), "npc") # new
grid.arrange(t, p, p, nrow = 1)

Related

Remove labels on NULL plots using plot_grid and cowplot

I am using plot_grid and cowplot to arrange plots in a grid. I need to have some "empty" plots in the grid. Using NULL works fine - but the space still gets labelled. Is there a way to make NULL plots have no label automatically? I know I can do all plot labels manually.
MWE (adapted from this page)
library(ggplot2)
df <- data.frame(
x = 1:10, y1 = 1:10, y2 = (1:10)^2, y3 = (1:10)^3, y4 = (1:10)^4
)
p1 <- ggplot(df, aes(x, y1)) + geom_point()
p2 <- ggplot(df, aes(x, y2)) + geom_point()
p3 <- ggplot(df, aes(x, y3)) + geom_point()
p4 <- ggplot(df, aes(x, y4)) + geom_point()
p5 <- ggplot(mpg, aes(as.factor(year), hwy)) +
geom_boxplot() +
facet_wrap(~class, scales = "free_y")
# simple grid
plot_grid(p1, NULL, p3, p4, labels = "AUTO")
I'm looking for the behaviour you could get with plot_grid(p1, NULL, p3, p4, labels = c("A","","B","C"), but I don't want to have to set up each plot individually
Here is a potential solution using a modified cowplot::plot_grid():
plot_grid_modified <- function(..., plotlist = NULL, align = c("none", "h", "v", "hv"),
axis = c("none", "l", "r", "t", "b", "lr", "tb", "tblr"),
nrow = NULL, ncol = NULL, rel_widths = 1,
rel_heights = 1, labels = NULL, label_size = 14,
label_fontfamily = NULL, label_fontface = "bold", label_colour = NULL,
label_x = 0, label_y = 1,
hjust = -0.5, vjust = 1.5, scale = 1., greedy = TRUE,
byrow = TRUE, cols = NULL, rows = NULL) {
# Make a list from the ... arguments and plotlist
plots <- c(list(...), plotlist)
num_plots <- length(plots)
if (!is.null(cols)){
warning("Argument 'cols' is deprecated. Use 'ncol' instead.")
}
if (!is.null(rows)){
warning("Argument 'rows' is deprecated. Use 'nrow' instead.")
}
scale <- rep_len(scale, num_plots)
if (sum(scale <= 0) > 1){
stop("Argument 'scale' needs to be greater than 0.")
}
# internally, this function operates with variables cols and rows instead of ncol and nrow
if (!is.null(ncol)){
cols <- ncol
}
if (!is.null(nrow)){
rows <- nrow
}
# calculate grid dimensions
if (is.null(cols) && is.null(rows)){
# if neither rows nor cols are given, we make a square grid
cols <- ceiling(sqrt(num_plots))
rows <- ceiling(num_plots/cols)
}
# alternatively, we know at least how many rows or how many columns we need
if (is.null(cols)) cols <- ceiling(num_plots/rows)
if (is.null(rows)) rows <- ceiling(num_plots/cols)
# if the user wants to layout the plots by column, we use the calculated rows to reorder plots
if (!isTRUE(byrow)) plots <- plots[c(t(matrix(c(1:num_plots, rep(NA, (rows * cols) - num_plots)), nrow = rows, byrow = FALSE)))]
# Align the plots (if specified)
grobs <- align_plots(plotlist = plots, align = align, axis = axis, greedy = greedy)
if ("AUTO" %in% labels) {
count <- 0
labels <- c()
for (idx in seq_along(plots)) {
if (!is.null(unlist(plots[idx]))) {
count <- count + 1
labels <- c(labels, LETTERS[count])
} else {
labels <- c(labels, "")
}
}
} else if ("auto" %in% labels) {
count <- 0
labels <- c()
for (idx in seq_along(plots)) {
if (!is.null(unlist(plots[idx]))) {
count <- count + 1
labels <- c(labels, letters[count])
} else {
labels <- c(labels, "")
}
}
}
# label adjustments can be provided globally for all labels
# or individually for each label
hjust <- rep_len(hjust, length(labels))
vjust <- rep_len(vjust, length(labels))
label_x <- rep_len(label_x, length(labels))
label_y <- rep_len(label_y, length(labels))
# calculate appropriate vectors of rel. heights and widths
rel_heights <- rep(rel_heights, length.out = rows)
rel_widths <- rep(rel_widths, length.out = cols)
# calculate the appropriate coordinates and deltas for each row and column
x_deltas <- rel_widths/sum(rel_widths)
y_deltas <- rel_heights/sum(rel_heights)
xs <- cumsum(rel_widths)/sum(rel_widths) - x_deltas
ys <- 1 - cumsum(rel_heights)/sum(rel_heights)
# now place all the plots
p <- ggdraw() # start with nothing
col_count <- 0
row_count <- 1
for (i in 1:(rows*cols)){
if (i > num_plots) break
x_delta <- x_deltas[col_count+1]
y_delta <- y_deltas[row_count]
x <- xs[col_count+1]
y <- ys[row_count]
# place the plot
p_next <- grobs[[i]]
if (!is.null(p_next)){
p <- p + draw_grob(p_next, x, y, x_delta, y_delta, scale[i])
}
# place a label if we have one
if (i <= length(labels)){
p <- p + draw_plot_label(labels[i], x + label_x[i]*x_delta, y + label_y[i]*y_delta, size = label_size,
family = label_fontfamily, fontface = label_fontface, colour = label_colour,
hjust = hjust[i], vjust = vjust[i])
}
# move on to next grid position
col_count <- col_count + 1
if (col_count >= cols){
col_count <- 0
row_count <- row_count + 1
}
}
p
}
library(ggplot2)
library(cowplot)
df <- data.frame(
x = 1:10, y1 = 1:10, y2 = (1:10)^2, y3 = (1:10)^3, y4 = (1:10)^4
)
p1 <- ggplot(df, aes(x, y1)) + geom_point()
p2 <- ggplot(df, aes(x, y2)) + geom_point()
p3 <- ggplot(df, aes(x, y3)) + geom_point()
p4 <- ggplot(df, aes(x, y4)) + geom_point()
p5 <- ggplot(mpg, aes(as.factor(year), hwy)) +
geom_boxplot() +
facet_wrap(~class, scales = "free_y")
# simple grid
plot_grid_modified(p1, NULL, p3, p4, labels = "AUTO")

ggplot from two tibbles; scatterplot with contours in background

I have two tibbles -
tbl1 contains real data : X, Y and choice.
tbl2 is synthetic tibble to calculate contours of predicted choice P.
library(tidyverse)
# tibble1
X <- c(1, 3, 5)
Y <- c(1, 5, 3)
choice <- c(0, 1, 1)
tbl1 <- tibble(X,Y,choice)
# tibble2
X <- seq(0, 5, 0.1)
Y <- seq(0, 5, 0.1)
tbl2 <- crossing(X,Y)
tbl2 <- tbl2 %>%
mutate(V = (X + Y - 4)/2,
P = 1/(1+exp(-V)))
I wish to create a single ggplot with
scatterplot X vs Y from tbl1 (with color = choice)
filled contours of P from tbl2 in the background
Thanks
Perhaps this?
library(ggplot2)
ggplot(tbl2, aes(X, Y)) +
geom_contour_filled(aes(z = P), alpha = 0.3) +
geom_point(aes(color = factor(choice)), size = 5, data = tbl1) +
guides(fill = guide_none()) +
labs(color = "Choice")

Align plot with different axes vertically using Cowplot

I am trying to align three plots (with different scales on the y-axis) on the left y-axis. In other words, I would like the red axis to be aligned:
However, the y-axis of the first plot does not align with the y-axis of the bottom left plot.
Code
# Libraries
library(tidyverse)
library(cowplot)
df1 <- data.frame(x = seq(0, 100, 1),
y = seq(100, 0, -1))
df2 <- data.frame(x = seq(0, 10, 0.1),
y = seq(1, 10^9, length.out = 101 ) )
p1 <- ggplot(data = df1) +
geom_line(aes(x = x, y = y))
p2 <- ggplot(data = df2) +
geom_line(aes(x = x, y = y))
combi_p2 <- plot_grid(p2, p2, nrow = 1)
plot_grid(p1, combi_p2, ncol = 1, axis = "l", align = "v")
Attempt to fix it
Using the information provided here, I rewrote the last part of the code:
require(grid) # for unit.pmax()
p1 <- ggplotGrob(p1) # convert to gtable
combi_p2 <- ggplotGrob(combi_p2) # convert to gtable
p1.widths <- p1$widths[1:3] # extract the first three widths,
# corresponding to left margin, y lab, and y axis
combi_p2.widths <- combi_p2$widths[1:3] # same for combi_p2 plot
max.widths <- unit.pmax(p1.widths, combi_p2.widths) # calculate maximum widths
p1$widths[1:3] <- max.widths # assign max. widths to p1 gtable
combi_p2$widths[1:3] <- max.widths # assign max widths to combi_p2 gtable
# plot_grid() can work directly with gtables, so this works
plot_grid(p1, combi_p2, labels = "AUTO", ncol = 1)
Sadly, I was not able to fix the alignment:
Question
How do I align the y-axis of the top plot with the left bottom plot using cowplot in R?
I think you can use ggplotGrob and put them together with gtable_rbind and gtable_cbind. Finally, you can draw the plot with grid.draw()
df1 <- data.frame(x = seq(0, 100, 1),
y = seq(100, 0, -1))
df2 <- data.frame(x = seq(0, 10, 0.1),
y = seq(1, 10^9, length.out = 101 ) )
p1 <- ggplot(data = df1) +
geom_line(aes(x = x, y = y))
p2 <- ggplot(data = df2) +
geom_line(aes(x = x, y = y))
g1 <- ggplotGrob(p1)
g2 <- ggplotGrob(p2)
frame_g2 <- gtable_frame(g2 , debug = TRUE)
frame_combi <- gtable_frame(gtable_cbind(frame_g2,frame_g2),
width = unit(2, "null"),
height = unit(1, "null"))
frame_g1 <-
gtable_frame(
g1,
width = unit(1, "null"),
height = unit(1, "null"),
debug = TRUE
)
grid.newpage()
all_frames <- gtable_rbind(frame_g1, frame_combi)
grid.draw(all_frames)
And this is how the plot looks.
A cowplot solution by Claus O. Wilke is presented here.
It is based on the align_plot function, which first aligns the top plot with the left bottom plot along the y-axis. Then the aligned plots are passed to the plot_grid function.
# Libraries
library(tidyverse)
library(cowplot)
df1 <- data.frame(x = seq(0, 100, 1),
y = seq(100, 0, -1))
df2 <- data.frame(x = seq(0, 10, 0.1),
y = seq(1, 10^9, length.out = 101 ) )
p1 <- ggplot(data = df1) +
geom_line(aes(x = x, y = y))
p2 <- ggplot(data = df2) +
geom_line(aes(x = x, y = y))
plots <- align_plots(p1, p2, align = 'v', axis = 'l')
bottom_row <- plot_grid(plots[[2]], p2, nrow = 1)
plot_grid(plots[[1]], bottom_row, ncol = 1)

Axis labels for facet_grid of ggplot [duplicate]

Here is some minimal code to generate a graph with two sets of facets.
library("ggplot2", quietly = TRUE, warn.conflicts = FALSE)
library("RColorBrewer", quietly = TRUE, warn.conflicts = FALSE)
val.a <- rnorm(10)
val.b <- rnorm(10)
val.c <- c("A","B","A","A","B","B","B","B","A","B")
val.d <- c("D","D","E","D","E","E","E","D","D","E")
val.e <- rnorm(10)
maya <- data.frame(val.a,val.b,val.c,val.d,val.e)
ggplot(maya, aes(x=val.a, y=val.b)) +
geom_point(shape=20,size=3, aes(colour=val.e)) +
facet_grid(val.c~val.d) +
xlab("Leonardo") + ylab("Michaelangelo") +
scale_colour_gradientn(colours=brewer.pal(9,"YlGnBu"), name="Splinter")
I can't figure out how to add an overall facet label so that the names Donatello and Raphael are on the top and right hand side axis.
I saw some similar solutions on SO, but I can't make heads or tails of the code. Please would you suggest an answer to my conundrum?
Similar question here, but it fails for me if I have more than two facets. The labels show up somewhere inside the graph. Is there a way to make this work for the general case?
So I tried rawr's solution at the link above, and it ended up at the same place for multiple columns. Here's the code updated to rawr's solution, but it's producing the labels in unexpected (for me because I don't understand the solution) places.
library("ggplot2", quietly = TRUE, warn.conflicts = FALSE)
library("RColorBrewer", quietly = TRUE, warn.conflicts = FALSE)
val.a <- rnorm(20)
val.b <- rnorm(20)
val.c <- c("A","B","C","D","E","F","G","H","I","J")
val.d <- c("A","B","C","D","E","F","G","H","I","J")
val.e <- rnorm(20)
maya <- data.frame(val.a,val.b,val.c,val.d,val.e)
p <- ggplot(maya, aes(x=val.a, y=val.b)) + geom_point(shape=20,size=3, aes(colour=val.e)) + facet_grid(val.c~val.d) + xlab("Leonardo") + ylab("Michaelangelo") + scale_colour_gradientn(colours=brewer.pal(9,"YlGnBu"), name="Splinter")
z <- ggplotGrob(p)
library(grid)
library(gtable)
# add label for right strip
z <- gtable_add_cols(z, unit(z$width[[7]], 'cm'), 7)
z <- gtable_add_grob(z,
list(rectGrob(gp = gpar(col = NA, fill = gray(0.5))),
textGrob("Variable 1", rot = -90, gp = gpar(col = gray(1)))),
4, 8, 6, name = paste(runif(2)))
# add label for top strip
z <- gtable_add_rows(z, unit(z$heights[[3]], 'cm'), 2)
z <- gtable_add_grob(z,
list(rectGrob(gp = gpar(col = NA, fill = gray(0.5))),
textGrob("Variable 2", gp = gpar(col = gray(1)))),
3, 4, 3, 6, name = paste(runif(2)))
# add margins
z <- gtable_add_cols(z, unit(1/8, "line"), 7)
z <- gtable_add_rows(z, unit(1/8, "line"), 3)
# draw it
grid.newpage()
grid.draw(z)
Please would someone kindly point out to me the part of the code that's telling it how wide the general facet label should be?
This is fairly general. The current locations of the top and right strips are given in the layout data frame. This solution uses those locations to position the new strips. The new strips are constructed so that heights, widths, background colour, and font size and colour are the same as in current strips. There are some explanations below.
# Packages
library(ggplot2)
library(RColorBrewer)
library(grid)
library(gtable)
# Data
val.a <- rnorm(20)
val.b <- rnorm(20)
val.c <- c("A","B","C","D","E","F","G","H","I","J")
val.d <- c("A","B","C","D","E","F","G","H","I","J")
val.e <- rnorm(20)
maya <- data.frame(val.a,val.b,val.c,val.d,val.e)
# Base plot
p <- ggplot(maya, aes(x = val.a, y = val.b)) +
geom_point(shape = 20,size = 3, aes(colour = val.e)) +
facet_grid(val.c ~ val.d) +
xlab("Leonardo") + ylab("Michaelangelo") +
scale_colour_gradientn(colours = brewer.pal(9,"YlGnBu"), name = "Splinter")
# Labels
labelR = "Variable 1"
labelT = "Varibale 2"
# Get the ggplot grob
z <- ggplotGrob(p)
# Get the positions of the strips in the gtable: t = top, l = left, ...
posR <- subset(z$layout, grepl("strip-r", name), select = t:r)
posT <- subset(z$layout, grepl("strip-t", name), select = t:r)
# Add a new column to the right of current right strips,
# and a new row on top of current top strips
width <- z$widths[max(posR$r)] # width of current right strips
height <- z$heights[min(posT$t)] # height of current top strips
z <- gtable_add_cols(z, width, max(posR$r))
z <- gtable_add_rows(z, height, min(posT$t)-1)
# Construct the new strip grobs
stripR <- gTree(name = "Strip_right", children = gList(
rectGrob(gp = gpar(col = NA, fill = "grey85")),
textGrob(labelR, rot = -90, gp = gpar(fontsize = 8.8, col = "grey10"))))
stripT <- gTree(name = "Strip_top", children = gList(
rectGrob(gp = gpar(col = NA, fill = "grey85")),
textGrob(labelT, gp = gpar(fontsize = 8.8, col = "grey10"))))
# Position the grobs in the gtable
z <- gtable_add_grob(z, stripR, t = min(posR$t)+1, l = max(posR$r) + 1, b = max(posR$b)+1, name = "strip-right")
z <- gtable_add_grob(z, stripT, t = min(posT$t), l = min(posT$l), r = max(posT$r), name = "strip-top")
# Add small gaps between strips
z <- gtable_add_cols(z, unit(1/5, "line"), max(posR$r))
z <- gtable_add_rows(z, unit(1/5, "line"), min(posT$t))
# Draw it
grid.newpage()
grid.draw(z)

How to have background fill in the plot in R

So, I've a t-dist plot created in R using curve and adding on the polygons onto that. It gives me a basic looking plot.
What I need is a more good looking plot where
X-axis starts from -6
Y-axis starts from 0
Background of the plot(except under the curve) is filled with some color which I need
I think I need to use the ggplot2 package for this, so answers based on ggplot2 usage is what I need. Or any answer that would return me that output is appreciated.
Here is my code
curve(dt(x, df = 7), from = -6, to = 6)
x <- seq(-1.96, -6, len = 100)
y <- dt(x, 7)
x1 <- seq(1.96, 6, len = 100)
y1 <- dt(x1, 7)
polygon(c(x1[1], x1, x1[100]), c(dt(-6, 7), y1, dt(6, 7)),
col = "#b14025", border = "black")
polygon(c(x[1], x, x[100]), c(dt(-6, 7), y, dt(6, 7)),
col = "#b14025", border = "black")
First Image is the current Output
Second Image is what I think it should look like
Here is one way to obtain a similar result using the ggplot2 package:
library(ggplot2)
dt_tails <- function(x){
y <- dt(x,7)
y[abs(x) < 1.96] <- NA
return(y)
}
dt_7 <- function(x) dt(x,7)
p <- ggplot(data.frame(x=c(-6,6)),aes(x=x)) +
stat_function(fun=dt_7, geom="area", fill="white", colour="black")
p <- p + stat_function(fun=dt_tails, geom="area", fill='#b14025')
p <- p + theme(panel.grid.major=element_blank(),
panel.grid.minor=element_blank(),
panel.background=element_rect(fill="#eae9c8") )
plot(p)
Since you expected a ggplot answer, just add + theme(panel.background = element_rect(fill = "yellow")) to your plot or what ever color you like.
I finally managed to do it with the base plotting functions only.
For Shading the area outside curve: I just added one more polygon tracing the area outside the curve.
For fixing the graph to start at the required X and Y, I used another parameter of plot function xaxs & yaxs from this Link
Here is my attached code
curve(dt(x, df = 7), from = -6, to = 6,xaxs="i",yaxs="i",ylim=c(0,0.4))
t = seq(-6,6,len = 100)
yt = dt(t,7)
x <- seq(-1.96, -6, len = 100)
y <- dt(x, 7)
x1 <- seq(1.96, 6, len = 100)
y1 <- dt(x1, 7)
polygon(x = c(-6,-6,t,6,6),
y = c(0.4,0,yt,0,0.4),
col = "#eae9c8",
border = "black")
polygon(x = c(x1[1], x1, x1[100]),
y = c(dt(-6, 7), y1, dt(6, 7)),
col = "#b14025",
border = "black")
polygon(x = c(x[1], x, x[100]),
y = c(dt(-6, 7), y, dt(6, 7)),
col = "#b14025",
border = "black")
Here is the attached output

Resources