Related
(I want to have a gtable object with some data, a header and a footnote.
Each of the three elements are gtables, which are combinded to one gtable-object using gtable_add_rows first, and then gtable_add_grob to arrange the three gtables into one grob. Unfortunately the headline/footnote is too long (resp. too short)
How can I set the width of headline/ footline ?
How can I assign the text of headline/ footline to left-alignment?
My code example:
require(gtable)
require(grid)
require(gridExtra)
tbl<-matrix(paste(letters[1:6]),nrow=2)
colnames(tbl)<-c(paste0("col",1:3))
rownames(tbl)<-c(paste0("row",1:2))
tbl
tt1 <- ttheme_default(base_size = 10,rowhead=list(fg_params=list(fontface=2,hjust=0, x=0)))
tt2 <- ttheme_default(base_size = 15,fg_params=list(fontface="bold",hjust=1,x=0.9))
tt3 <- ttheme_default(base_size =7, fg_paras=list(fontface="italic",hjust=0,x=0.9))
gtbl <- tableGrob(tbl, theme=tt1)
htxt <- tableGrob("Headline is too long and this is stupid", theme=tt2)
ftxt <- tableGrob("Footnote", theme=tt3)
padding <- unit(1,"line")
table <- gtable_add_rows(gtbl,
heights = grobHeight(htxt) + padding,
pos = 0)
table <- gtable_add_rows(table,
heights = grobHeight(ftxt)+ padding)
table <- gtable_add_grob(table, list(htxt, ftxt),
t=c(1, nrow(table)), l=c(1,1),
r=ncol(table))
dim(table)
grid.newpage()
grid.draw(table)
Thanks for any help!
Volker
I solved my problem.
Only two minor problems are left. See below my commented code.
# load packages ------------------------------------------------------------
require(gtable)
require(grid)
require(gridExtra)
# id makro ----------------------------------------------------------------
# see here: https://stackoverflow.com/questions/43613320/how-to-add-multi-sub-columns-in-gridextratablegrob/43620247#43620247
# Tanks to: baptiste
id_cell <- function(table, row, col, name="colhead-fg"){
l <- table$layout
which(l$t %in% row & l$l %in% col & l$name==name)
}
# code to test it----------------------------------------------------------------
# Some different table themes
tt1 <- ttheme_default(base_size = 10,rowhead=list(fg_params=list(fontface=2,hjust=0, x=0))) # Data
tt2 <- ttheme_default(base_size = 15,fg_params=list(fontface="bold",hjust=1,x=0.9)) # Header
tt3 <- ttheme_default(base_size = 7,fg_params=list(fontface="italic",hjust=0,x=0.9)) # Footnote
# Convert to gtable
# 1. Data
# The data
tbl<-matrix(paste(letters[1:6]),nrow=2)
colnames(tbl)<-c("col1","column2","verywidecolum3")
rownames(tbl)<-c(paste0("row",1:2))
gtbl <- tableGrob(tbl, theme=tt1)
# 2. Headline
# Note: Define the Headline as gtable with as many columns a your Data
# Headline is defined in last colum due to the Makro id_cells.
hl<-"Headline"
hlm<-matrix(c(rep("",(dim(gtbl)[2]-1)),hl),nrow=1)
hlm
htxt <- tableGrob(hlm, theme=tt2)
# 3. Footnote
# Note: Define the Footnote as gtable with as many columns a your Data
# The text of your footnote is defined in last colum due to the Makro id_cells.
ftm<-matrix(c(rep("",(dim(gtbl)[2]-1)),"Footnote"),nrow=1)
ftxt <- tableGrob(ftm, theme=tt3)
# Define your table with Headline, Data and Footnote in one gtable object
tab2<-combine(htxt,gtbl,ftxt,along=2)
# Draw Grid - not formated
grid.newpage()
grid.draw(tab2)
# Formating of Grid Table
# Adjust columnwidths: same widths for each column
tab2$widths <- unit(rep(1/ncol(tab2), ncol(tab2)), "null")
#
rowg<-dim(tab2)[1] # Number of rows of your gtable
colg<-dim(tab2)[2] # Number of columns of your gtable
eleg<-2*rowg*colg # Number of grobs of your gtable
# Note: Grobs in gtables are arranged in rows. Within each row first grob class "text" is repeated for the columns of gtable, then grob class "rect"
# Identify Grob elements which should be formated
# This is Headline and footnote,
forg<-c(1:colg,(eleg-2*colg+1):(eleg-colg));forg
for (i in forg){
if ((class(tab2$grobs[[i]])=="text")[1] == TRUE) {
print(i)
tab2$grobs[[i]]$x<-unit(0,"npc")
tab2$grobs[[i]]$hjust<-0
}
}
# Headline over all cells
idh <- id_cell(tab2, 1, colg,"core-fg")
tab2$layout[idh,"l"] <- tab2$layout[idh,"l"] - (colg-1)
# Footnote over all cells
idf <- id_cell(tab2, rowg, colg,"core-fg")
tab2$layout[idf,"l"] <- tab2$layout[idf,"l"] - (colg-1)
# Draw grid
grid.newpage()
grid.draw(tab2)
My two minor problems:
a) This code
tab2$widths <- unit(rep(1/ncol(tab2), ncol(tab2)), "null")
makes the same widths for each column. But it seems, that it is not the minimal needed columnwidth. In my example it is the minimum needed width of the last column. How to fit the columns with the minimal needed columnwidth, so that each column has the same width?
b) How to change babtistes function id_cell,
# id makro ----------------------------------------------------------------
# see here: https://stackoverflow.com/questions/43613320/how-to-add-multi-sub-columns-in-gridextratablegrob/43620247#43620247
# Tanks to: baptiste
id_cell <- function(table, row, col, name="colhead-fg"){
l <- table$layout
which(l$t %in% row & l$l %in% col & l$name==name)
}
that it is possible to specify first the header/footnote an then the neccessary empty cells?
This is related to this code section:
# 2. Headline
# Note: Define the Headline as gtable with as many columns a your Data
# Headline is defined in last colum due to the Makro id_cells.
hl<-"Headline"
hlm<-matrix(c(rep("",(dim(gtbl)[2]-1)),hl),nrow=1)
htxt <- tableGrob(hlm, theme=tt2)
and
# Headline over all cells
idh <- id_cell(tab2, 1, colg,"core-fg")
tab2$layout[idh,"l"] <- tab2$layout[idh,"l"] - (colg-1)
Is there a way of mixing ggplot2 with other type of plots (survplot, plot, etc.). I have tried par and layout but nothing seems to be appropriate.
Thanks
I use the function grid.arrange within the package grid.Extra
You haven't provided sample data, but if you have 4 plots saved as "a", "b", "c" and "d", your code would be as follows:
grid.arrange(a, b, c, d, nrow=2, ncol=2)
You can use "?grid.arrange" to learn more about adding additional things into your plot, like a title, the heights of the images, etc.
grid.arrange(a, b, c, d, nrow=4), top="YourTitleHere", heights=c(3,1,3,1))
There exist a nice function multiplot, which I have in my own standard library always loaded. It can be googled but here it is.
# Multiple plot function
#
# ggplot objects can be passed in ..., or to plotlist (as a list of ggplot objects)
# - cols: Number of columns in layout
# - layout: A matrix specifying the layout. If present, 'cols' is ignored.
#
# If the layout is something like matrix(c(1,2,3,3), nrow=2, byrow=TRUE),
# then plot 1 will go in the upper left, 2 will go in the upper right, and
# 3 will go all the way across the bottom.
#
library(ggplot2)
multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
library(grid)
# Make a list from the ... arguments and plotlist
plots <- c(list(...), plotlist)
numPlots = length(plots)
# If layout is NULL, then use 'cols' to determine layout
if (is.null(layout)) {
# Make the panel
# ncol: Number of columns of plots
# nrow: Number of rows needed, calculated from # of cols
layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
ncol = cols, nrow = ceiling(numPlots/cols))
}
if (numPlots==1) {
print(plots[[1]])
} else {
# Set up the page
grid.newpage()
pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))
# Make each plot, in the correct location
for (i in 1:numPlots) {
# Get the i,j matrix positions of the regions that contain this subplot
matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))
print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
layout.pos.col = matchidx$col))
}
}
}
I am trying to create an infographic showing scores with one grouping factor and one identifying factor using a stacked barchart in R. I want to write the ID on top of the relevant section of the bar. All the answers I've come across discuss how to add the value of the bar as a label, not the row name.
This is what I have at the moment:
id <- letters[seq(1,4)]
groups <- LETTERS[seq(1,8)]
scores <- matrix((c(0,0,7,0,0,0,0,0,0,0,0,0,0,2,0,0,0,0,8,0,0,0,0,0,0,0,0,0,0,8,0,2)),ncol=8)
row.names(scores) <- id
par(mfrow=c(1, 1), mar=c(2, 5, 2, 2))
bb <- barplot(scores, horiz = T, las = 2, cex.names = 0.5,xaxt="n", cex.axis=0.5,cex.lab=0.5, legend=F,main="Weekly Scores", space=0, border=NA)
I want something like this Adding values to barplot of table in R
but horizontal instead of vertical bars, and the ID text (a,b,c etc) in place of the values. I'd rather not use ggplot or any other package if possible (using packages limits user friendliness of code at work due to admin rights).
To make things more complicated, my ID values are (and have to remain so for the purposes of the graphic) sentence length.... I am currently wrapping them using a function I found online:
# Write function to wrap labels
wrap.it <- function(x, len)
{
sapply(x, function(y) paste(strwrap(y, len),
collapse = "\n"),
USE.NAMES = FALSE)
}
# Call this function with a list or vector
wrap.labels <- function(x, len)
{
if (is.list(x))
{
lapply(x, wrap.it, len)
} else {
wrap.it(x, len)
}
}
so I will want to "fit" the wrapped text into the bar. Any help appreciated!
You can add text an values. Modify as you desire.
id <- letters[seq(1,4)]
groups <- LETTERS[seq(1,8)]
scores <- matrix((c(2,0,7,0,1,2,0,1,0,1,2,0,0,2,0,0,0,0,8,0,0,0,3,1,0,0,2,0,0,8,0,2)),ncol=8)
row.names(scores) <- id
acsc=apply(scores,2,cumsum)
par(mfrow=c(1, 1), mar=c(2, 5, 2, 2))
bb <- barplot(scores, horiz = T, las = 2, cex.names = 0.5,xaxt="n",col=c("grey60","grey70","grey80","grey90"),
cex.axis=0.5,cex.lab=0.5, legend=F,main="Weekly Scores", space=0, border=NA)
sapply(1:4,function(z)
text(acsc[z,]-.3,bb,labels=sapply(scores[z,],function(zr)ifelse(zr==0,"",paste(rownames(scores)[z],zr,sep="="))),cex=.8))
axis(2,at=bb,groups)
I know variations on this question have been up several times, but couldn't figure out how to apply those solutions to this particular challenge:
I would like to use ggplot inside a d*ply call to plot the data (data frame dat below) broken up by the v3variable and display a numeric variable v2 for the 3 conditions in v1. I want to have the plots in one page (pdf), so thought I could use dlply to contain resulting plots in a list that then could be fed to the multiplot wrapper function for ggplot2 found in 'Cookbook for R' here
# Multiple plot function
#
# ggplot objects can be passed in ..., or to plotlist (as a list of ggplot objects)
# - cols: Number of columns in layout
# - layout: A matrix specifying the layout. If present, 'cols' is ignored.
#
# If the layout is something like matrix(c(1,2,3,3), nrow=2, byrow=TRUE),
# then plot 1 will go in the upper left, 2 will go in the upper right, and
# 3 will go all the way across the bottom.
#
multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
require(grid)
# Make a list from the ... arguments and plotlist
plots <- c(list(...), plotlist)
numPlots = length(plots)
# If layout is NULL, then use 'cols' to determine layout
if (is.null(layout)) {
# Make the panel
# ncol: Number of columns of plots
# nrow: Number of rows needed, calculated from # of cols
layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
ncol = cols, nrow = ceiling(numPlots/cols))
}
if (numPlots==1) {
print(plots[[1]])
} else {
# Set up the page
grid.newpage()
pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))
# Make each plot, in the correct location
for (i in 1:numPlots) {
# Get the i,j matrix positions of the regions that contain this subplot
matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))
print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
layout.pos.col = matchidx$col))
}
}
}
Here is a toy data frame:
set.seed(999)
dat <- data.frame(
v1 = rep(c("A","B","C"),25),
v2 = runif(75,-1,2),
v3 = sample(c("hippo", "smoke", "meat"), 75, replace=T))
Here is the best I could come up with - it gives the plots separately but doesnt merge them, and gives a strange output in console. Note that any solution not using multiplot() is just as good for me.
require(dplyr)
require(ggplot2)
p <- dlply(dat, .(v3), function(x){
ggplot(x,aes(v1, v2)) +
geom_point()})
multiplot(plotlist=p, cols=2)
Here's a different way that avoids multiplot() and uses techniques shown here and here:
library(ggplot2)
library(dplyr)
results <- dat %>%
group_by(v3) %>%
do(plot = ggplot(., aes(v1, v2)) + geom_point())
pdf('all.pdf')
invisible(lapply(results$plot, print))
dev.off()
I'm trying my first steps purely in grid. As an exercise, I would like to create a pairs plot (similar to pairs()) purely based on grid. The function myplotGrob below should create the grid object (grob; or gTree) and return the object.
I'm not sure
what's the best way to continue. Which units should one use? (tried "null", too)
Is frameGrob meant to set up the layout? (this is what I understood from Paul Murrell's book) How do I have to choose/adjust the viewports such that I get the desired plot (so far, I only see a mess) Is the layout meant to be set up beforehand or is it better to just step-by-step "concatenate" additional panels to get the (4, 4) plot matrix?
require(grid)
require(mvtnorm)
set.seed(271)
X <- rmvnorm(1000, mean=1:4, sigma=diag(4:1)) # goal: draw this in a pairs plot
## auxiliary function
panel <- function(x, y) pointsGrob(x=x, y=y, name="panel", gp=gpar(), vp=NULL)
## creates and returns a gTree (class)
myplotGrob <- function(X, name=NULL, gp=NULL, vp=NULL)
{
## x-axis grob
## y-axis grob
## ...
## set up layout
layout <- grid.layout(4, 4, # (4, 4) matrix
widths=rep(0.25, 4), heights=rep(0.25, 4),
default.units="npc")
## pushViewport(viewport(layout=layout)) # required???
all <- frameGrob(layout=layout) # produces a gTree without children
for(i in 1:4) {
for(j in 1:4) {
## group grobs together
gt <- gTree(X,
children=gList(panel(X[,i], X[,j])),
name=name, gp=gp, vp=vp, cl="myplotGrob")
all <- placeGrob(all, gt, row=i, col=j)
}
}
all
}
## draw the gTree
grid.myplot <- function(...) grid.draw(myplotGrob(...))
## call
grid.myplot(X)
UPDATE
As it was asked for, here is the design/layout of the original problem I have in mind (the above would have only been a minimal/learning example). The units in cm were just for me (they should be 'relative' in the end). Of course, the number of panels may vary. I would like all parts to be grid objects, so that the function which creates the graphic will return an object (without printing/drawing). This way, each part can be modified afterwards. The graphic should display results from an array of dimension 5 (or less): one dimension is displayed in the row panels [row.vars], one in the column panels [col.vars], one on the x axis of each panel [xvar], and each panel can contain 2 different dimensions of the array (differing by color and line type) [I used d and n in the drawing]. If course, if the array is four-dimensional, then row 8 of the above design should be missing. I can construct the layout via grid, but the whole question is how to continue from there. That's what I wanted to express with my "minimal example" above.
I think you can divide the task in two main parts, like the basic examples in grid.panel() and grid.multipanel()
1- build a function that will produce a single panel, returned as a gTree. You need to figure out all the parameters, i.e. limits, axes, colours, shapes, grid, coordinates, ... You might end up rewriting lattice panel functions and axes,
grid.newpage()
grid::grid.panel(vp=viewport(width=0.8, height=0.8))
2- assemble the panels in a layout. This is much easier (and cleaner) with gtable,
library(gtable)
grid.newpage()
lg <- replicate(16, grobTree(rectGrob(), pointsGrob()), simplify=FALSE)
gt <- gtable_matrix("pairs", grobs=matrix(lg, ncol=4),
widths=unit(rep(1, 4), "null"),
heights=unit(rep(1, 4), "null"))
gt <- gtable_add_col_space(gt, width=unit(0.5,"line"))
gt <- gtable_add_row_space(gt, height=unit(0.5,"line"))
gt <- gtable_add_padding(gt, padding=unit(1,"line"))
grid.draw(gt)
If you want to build everything from scratch, here too you'll end up having to reinvent a good portion of gtable, I reckon.
Here's an attempt similar to grid.multipanel() but returning a gTree, and more specific to your pairs plot,
require(grid)
require(mvtnorm)
set.seed(271)
X <- rmvnorm(100, mean=1:4, sigma=diag(4:1)) # goal: draw this in a pairs plot
panelGrob <- function(x=runif(10, -10, 10), y=runif(10, -10, 100), ...,
xlim = range(x), ylim=range(y),
axis.x=TRUE, axis.y=TRUE){
xx <- pretty(x) ; yy <- pretty(y)
xx <- xx[xx <= xlim[2] & xx >= xlim[1]]
yy <- yy[yy <= ylim[2] & yy >= ylim[1]]
r <- rectGrob()
dvp <- dataViewport(xData=xx, yData=yy)
p <- pointsGrob(x, y, pch=".", gp=gpar(col="red"), default.units="native",
vp = dvp)
ax <- if(axis.x) xaxisGrob(at=xx, vp=dvp) else nullGrob()
ay <- if(axis.y) yaxisGrob(at=yy, vp=dvp) else nullGrob()
grobTree(r, ax, ay, p, ...)
}
grid.panel <- function(...)
grid.draw(panelGrob(...))
grid.newpage()
grid.panel(vp=viewport(width=0.8, height=0.8))
pairsGrob <- function(X, ..., name=NULL, gp=NULL, vp=NULL){
N <- NCOL(X)
layout <- grid.layout(N+1, N+1,
widths=unit(c(2, rep(1, N)), c("lines", rep("null", N))),
heights = unit(c(rep(1, N), 2), c(rep("null", N), "lines")))
wrap <- function(ii, jj, ...){
panelGrob(X[,ii], X[,jj], ..., axis.x= ii == N, axis.y = jj == 1,
vp=viewport(layout.pos.row=ii, layout.pos.col=jj+1))
}
rowcol <- expand.grid(ii=seq_len(N), jj=seq_len(N))
gl <- mapply(wrap, ii=rowcol[,"ii"], jj=rowcol[,"jj"], MoreArgs=list(...),
SIMPLIFY=FALSE)
gTree(children=do.call(gList, gl), vp=viewport(layout=layout))
}
grid.pairs <- function(...) grid.draw(pairsGrob(...))
grid.newpage()
grid.pairs(X, xlim=c(-10,10), ylim=c(-10,10))
Many problems are already apparent: i) it's cumbersome to add spacings in the layout, keeping track of the right viewports; ii) most parameters of the panel function are hard-wired (point shape, colour, grid, axis labels, ...), be prepared for an explosion in complexity, as in args(lattice::panel.xyplot); iii) the range of the axes should match across one row / column, which requires some thought about splitting the data properly in groups (facetting in ggplot2 or lattice); iv) the legend is yet another thing to reinvent in grid; v) ...