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)
Related
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)
Basically, I want to add a title and subtitle to a grid.arrange() plot.
I have plot_list which is a list of 15 ggplots and
tg <- textGrob('Title', gp = gpar(fontsize = 13, fontface = 'bold'))
sg <- textGrob('Subtitle', gp = gpar(fontsize = 10))
But this doesn't work. I don't get any errors but tg and sg don't show up in the plot.
grid.arrange(tg, sg, grobs = plot_list, ncol = 3)
To be honest, I'm no expert in gridExtra and grid so any advice will be appreciated
Following changing multiple line title in multiplot ggplot2 using grid.arrange I could do what you asked for by creating two grids, first with only the plots and second with title, subtitle and the first grid. Using a synthetic plot_list:
df <- data.frame(v1 = rnorm(1000))
plot_list <- list()
for (i in 1:15) {
df[,ncol(df)+1] <- rnorm(1000)
names(df)[ncol(df)] <- paste0("V_",as.character(i))
local({
i <- i
plot_list[[i]] <<- ggplot(df) + geom_point(aes_string(x = "v1", y = paste0("V_",as.character(i))))
})
}
tg <- textGrob('Title', gp = gpar(fontsize = 13, fontface = 'bold'))
sg <- textGrob('Subtitle', gp = gpar(fontsize = 10))
margin <- unit(0.5, "line")
grided <- gridExtra::grid.arrange(grobs = plot_list, ncol = 3)
gridExtra::grid.arrange(tg, sg, grided,
heights = unit.c(grobHeight(tg) + 1.2*margin,
grobHeight(sg) + margin,
unit(1,"null")))
Hope this helps!
You need to combine tg, sg and your plots into a list. I would specify a layout matrix, which gives you a bit more control, and plot using grid.arrange:
First, we have tg,sg and I make a plot_list of 3 with mtcars.
library(ggplot2)
library(gridExtra)
library(grid)
tg <- textGrob('Title', gp = gpar(fontsize = 13, fontface = 'bold'))
sg <- textGrob('Subtitle', gp = gpar(fontsize = 10))
plot_list <- lapply(c("drat","wt","qsec"),function(i){
ggplot(mtcars,aes_string("mpg",i))+geom_point()
})
We combine your plots in a list:
g = c(list(tg),list(sg),plot_list)
So now tg is 1st element, sg is 2nd element and your plots are 3-5. We specify the layout:
N = length(plot_list)
laym = rbind(rep(1,N),rep(2,N),(3:(N+2)))
laym
[,1] [,2] [,3]
[1,] 1 1 1
[2,] 2 2 2
[3,] 3 4 5
This matrix will have the first one (tg), 1 takes up first row, sg 2nd row and your plots third row. If you have other kinds of arrangements or list, you can change this accordingly.
Now we plot, and specify the relative heights using heights=...
grid.arrange(grobs=g,layout_matrix=laym,heights=c(1,1,10))
the top argument can take any grob but it needs to know its height to be given the right space,
library(grid)
library(gridExtra)
lg <- replicate(12, ggplot2::ggplot(), simplify = FALSE)
tg <- textGrob('Title', gp = gpar(fontsize = 50, fontface = 'bold'))
sg <- textGrob('Subtitle', gp = gpar(fontsize = 10))
lt <- list(tg, sg)
heights <- do.call(unit.c, lapply(lt, function(.g) 1.5*grobHeight(.g)))
titles <- gtable::gtable_matrix('title',
grobs = matrix(lt, ncol=1),
widths = unit(1,'npc'),
heights = heights)
grobHeight.gtable <- function(g) sum(g$heights)
grid.arrange(grobs = lg, top = titles)
I have a z-scores matrix:
set.seed(1)
z.score.mat <- matrix(rnorm(1000),nrow=100,ncol=10)
which are the result of some biological experimental data, and a corresponding p-value matrix:
p.val.mat <- pnorm(abs(z.score.mat),lower.tail = F)
Both have identical dimnames:
rownames(z.score.mat) <- paste("p",1:100,sep="")
colnames(z.score.mat) <- paste("c",1:10,sep="")
rownames(p.val.mat) <- paste("p",1:100,sep="")
colnames(p.val.mat) <- paste("c",1:10,sep="")
I'm plotting a hierarchically clustered heatmap of the z-scores like this:
hc.col <- hclust(dist(z.score.mat))
dd.col <- as.dendrogram(hc.col)
col.ord <- order.dendrogram(dd.col)
hc.row <- hclust(dist(t(z.score.mat)))
dd.row <- as.dendrogram(hc.row)
row.ord <- order.dendrogram(dd.row)
clustered.mat <- z.score.mat[col.ord,row.ord]
clustered.mat.names <- attr(clustered.mat,"dimnames")
clustered.mat.df <- as.data.frame(clustered.mat)
colnames(clustered.mat.df) <- clustered.mat.names[[2]]
clustered.mat.df[,"process"] <- clustered.mat.names[[1]]
clustered.mat.df[,"process"] <- with(clustered.mat.df,factor(clustered.mat.df[,"process"],levels=clustered.mat.df[,"process"],ordered=TRUE))
require(reshape2)
clustered.mat.df <- reshape2::melt(clustered.mat.df,id.vars="process")
colnames(clustered.mat.df)[2:3] <- c("condition","z.score")
clustered.mat.df$p.value <- sapply(1:nrow(clustered.mat.df),function(x) p.val.mat[which(rownames(p.val.mat) == clustered.mat.df$process[x]),which(colnames(p.val.mat) == clustered.mat.df$condition[x])])
lab.legend <- colnames(clustered.mat.df)[3]
lab.row <- colnames(clustered.mat.df)[1]
lab.col <- colnames(clustered.mat.df)[2]
require(ggplot2)
ggplot(clustered.mat.df,aes(x=condition,y=process))+
geom_tile(aes(fill=z.score))+
scale_fill_gradient2(lab.legend,high="darkred",low="darkblue")+
theme_bw()+
theme(legend.key=element_blank(),
legend.position="right",
panel.border=element_blank(),
strip.background=element_blank(),
axis.text.x=element_text(angle=45,vjust=0.5)
)
My question is if it is possible, and how, to have on one side of the legend bar the z-score range (which is currently on the right hand) and on the other side the corresponding p-value range?
This is quite fiddly when the plot dimensions change, but you do get the required result:
br <- seq(-3, 3, 1)
lab <- round(pnorm(abs(br),lower.tail = F), 3)
p <- ggplot(clustered.mat.df,aes(x=condition,y=process))+
geom_tile(aes(fill=z.score), show.legend = FALSE)+
scale_fill_gradient2(lab.legend, high="darkred", low="darkblue", breaks = br)
p1 <- ggplot(clustered.mat.df,aes(x=condition,y=process))+
geom_tile(aes(fill=z.score))+
scale_fill_gradient2(lab.legend, high="darkred", low="darkblue", breaks = br) +
guides(fill = guide_colorbar(title = '', label.position = 'right', barheight = 10))
p2 <- ggplot(clustered.mat.df,aes(x=condition,y=process))+
geom_tile(aes(fill=z.score))+
scale_fill_gradient2(lab.legend, high="darkred", low="darkblue", breaks = br, labels = lab) +
guides(fill = guide_colorbar('', label.position = 'left', barheight = 10))
library(cowplot)
l1 <- get_legend(p1)
l2 <- get_legend(p2)
ggdraw() +
draw_plot(p, width = 0.85) +
draw_grob(l1, 0.89, 0, 0.1, 1) +
draw_grob(l2, 0.85, 0, 0.1, 1) +
draw_label('p z', 0.88, 0.675, hjust = 0)
This approach uses gtable and grid functions. It takes the legend from your plot, edits the legend so that the p values appear on the left side, then puts the edited legend back into the plot.
# Your data
set.seed(1)
z.score.mat <- matrix(rnorm(1000),nrow=100,ncol=10)
# which are the result of some biological experimental data, and a corresponding p-value matrix:
p.val.mat <- pnorm(abs(z.score.mat),lower.tail = F)
rownames(z.score.mat) <- paste("p",1:100,sep="")
colnames(z.score.mat) <- paste("c",1:10,sep="")
rownames(p.val.mat) <- paste("p",1:100,sep="")
colnames(p.val.mat) <- paste("c",1:10,sep="")
hc.col <- hclust(dist(z.score.mat))
dd.col <- as.dendrogram(hc.col)
col.ord <- order.dendrogram(dd.col)
hc.row <- hclust(dist(t(z.score.mat)))
dd.row <- as.dendrogram(hc.row)
row.ord <- order.dendrogram(dd.row)
clustered.mat <- z.score.mat[col.ord,row.ord]
clustered.mat.names <- attr(clustered.mat,"dimnames")
clustered.mat.df <- as.data.frame(clustered.mat)
colnames(clustered.mat.df) <- clustered.mat.names[[2]]
clustered.mat.df[,"process"] <- clustered.mat.names[[1]]
clustered.mat.df[,"process"] <- with(clustered.mat.df,factor(clustered.mat.df[,"process"],levels=clustered.mat.df[,"process"],ordered=TRUE))
require(reshape2)
clustered.mat.df <- reshape2::melt(clustered.mat.df,id.vars="process")
colnames(clustered.mat.df)[2:3] <- c("condition","z.score")
clustered.mat.df$p.value <- sapply(1:nrow(clustered.mat.df),function(x) p.val.mat[which(rownames(p.val.mat) == clustered.mat.df$process[x]),which(colnames(p.val.mat) == clustered.mat.df$condition[x])])
lab.legend <- colnames(clustered.mat.df)[3]
lab.row <- colnames(clustered.mat.df)[1]
lab.col <- colnames(clustered.mat.df)[2]
# Your plot
require(ggplot2)
p = ggplot(clustered.mat.df,aes(x=condition,y=process))+
geom_tile(aes(fill=z.score))+
scale_fill_gradient2(lab.legend,high="darkred",low="darkblue") +
theme_bw()+
theme(legend.key=element_blank(),
legend.position="right",
panel.border=element_blank(),
strip.background=element_blank(),
axis.text.x=element_text(angle=45,vjust=0.5))
library(gtable)
library(grid)
# Get the ggplot grob
g = ggplotGrob(p)
# Get the legend
index = which(g$layout$name == "guide-box")
leg = g$grobs[[index]]
# Get the legend labels
# and calculate corresponding p values
z.breaks = as.numeric(leg$grobs[[1]]$grobs[[3]]$label)
p.breaks = as.character(round(pnorm(abs(z.breaks), lower.tail = F), 3))
# Get the width of the longest p.break string, taking account of font and font size
w = lapply(na.omit(p.breaks), function(x) grobWidth(textGrob(x,
gp = gpar(fontsize = leg$grobs[[1]]$grobs[[3]]$gp$fontsize,
fontfamily = leg$grobs[[1]]$grobs[[3]]$gp$fontfamily))))
w = do.call(unit.pmax, w)
w = convertX(w, "mm")
# Add columns to the legend gtable to take p.breaks,
# setting the width of relevant column to w
leg$grobs[[1]] = gtable_add_cols(leg$grobs[[1]], leg$grobs[[1]]$widths[3], 1)
leg$grobs[[1]] = gtable_add_cols(leg$grobs[[1]], w, 1)
# Construct grob containing p.breaks
# Begin with the z.score grob, then make relevant changes
p.values = leg$grobs[[1]]$grobs[[3]]
p.values[c("label", "x", "hjust")] = list(p.breaks, unit(1, "npc"), 1)
# Put the p.values grob into the legend gtable
leg$grobs[[1]] = gtable_add_grob(leg$grobs[[1]], p.values, t=4, l=2,
name = "p.values", clip = "off")
# Put 'p' and 'z' labels into the legend gtable
leg$grobs[[1]] = gtable_add_grob(leg$grobs[[1]], list(textGrob("p"), textGrob("z")),
t=2, l=c(2,6), clip = "off")
# Drop the current legend title
leg$grobs[[1]]$grobs[[4]] = nullGrob()
# Put the legend back into the plot,
# and make sure the relevant column is wide enough to take the new legend
g$grobs[[index]] = leg
g$widths[8] = g$widths[8] + sum(leg$grobs[[1]]$widths[2:3])
# Draw the plot
grid.newpage()
grid.draw(g)
Not precisely what you described, but you could put both p values and z values into the same labels on one side of the legend:
z.breaks = c(-2,0,2)
p.breaks = pnorm(abs(z.breaks),lower.tail = F)
ggplot(clustered.mat.df,aes(x=condition,y=process)) +
geom_tile(aes(fill = z.score)) +
scale_fill_gradient2("z score (p value)", high="darkred",low="darkblue",
breaks = z.breaks,
labels = paste0(z.breaks, ' (p = ', round(p.breaks,2), ')') ) +
theme_bw() +
theme(legend.key = element_blank(),
legend.position = 'right',
panel.border = element_blank(),
strip.background = element_blank(),
axis.text.x=element_text(angle=45,vjust=0.5))
I am using the following code to make a map with proportional points to an outter characteristic (Total), but i would like to change the width of the marker.
p <- ggplot()
p <- p + geom_polygon( data=all_states, aes(x=LONG*-1, y=LAT, group = ID),colour="black", fill="white" )
p <- p + geom_point( data=mydata, aes(x=long*-1, y=lat, size = Total),color="mediumblue", shape=1) +
scale_size(range = c(1,11), name="Sells Volume")+
labs(title="Reglone SL")+
xlab(" ")+
ylab(" ")
p
Is it the thickness of the boundary of a hollow point that you want to change? It can be done with grid.edit from the grid package.
library(ggplot2)
library(grid)
ggplot(data = data.frame(x = 1:10, y = 1:10), aes(x=x, y=y)) +
geom_point(size = 10, shape = 1)
grid.force() # To make the grobs visible to grid editing tools
grid.edit("geom_point.points", grep = TRUE, gp = gpar(lwd = seq(1, 5.5, .5)))
EDIT To get legend keys to match the points
library(ggplot2)
library(grid)
library(gtable)
p = ggplot(data = data.frame(x = 1:10, y = 1:10, c = c(rep("a", 5), rep("b", 5))),
aes(x=x, y=y, colour = c)) +
geom_point(shape = 1, size = 10)
lwd = 8 # Set line width
g = ggplotGrob(p); dev.off() # Get the plot grob
# Get the indices for the legend: t = top, r = right, ...
indices <- c(subset(g$layout, name == "guide-box", select = t:r))
# Get the row number of the legend in the layout
rn <- which(g$layout$name == "guide-box")
# Extract the legend
legend <- g$grobs[[rn]]
# Get the legend keys
pointGrobs = which(grepl("points", legend$grobs[[1]]$grobs))
# Check them out - no line width set
# for (i in pointGrobs) str(legend$grobs[[1]]$grobs[[i]])
# Set line width
for (i in pointGrobs) legend$grobs[[1]]$grobs[[i]]$gp$lwd = lwd
# Check them out - line width set
# for (i in pointGrobs) str(legend$grobs[[1]]$grobs[[i]])
# Put the modified legend back into the plot grob
g = gtable_add_grob(g, legend, t=indices$t, l=indices$l)
# g$grobs[[4]]$children[[2]]$gp$lwd = lwd # Alternative for setting lwd for points in the plot
grid.newpage()
grid.draw(g)
grid.force() # To make the grobs visible to grid editing tools
grid.edit("geom_point.points", grep = TRUE, gp = gpar(lwd = lwd))
I'm trying to make a function that will give me a plot ready for indesign, illustrator or inkscape. In trying to do so, I have 2 problems I cannot solve.
1) set the width and height of my plot (or just the grobTable):
The output I get is very small and when upscaling it in illustrator the font follows and become way to big. Therefore I want to make plots with manually defined widths and heights.
2) Sometimes the title, note and rownames gets "misplaced" (see the difference between plot 1 and 2 for details). It happens when the rownames are short.
library(gridExtra)
library(ggplot2)
data(diamonds)
## plot function
kryds.row <- function(x,y, p=100, decor="%", digits=3,
titel="", note="", red=219, green=55, blue= 153){
c <- table(x, y)
s <- as.character(sum(c))
s <- paste("Antal svarpersoner=", s, sep=" ")
j <- prop.table(c,1)
r <- c(rownames(j),"Total")
k <- c(colnames(j), "Total")
j <- addmargins(j, margin =2, FUN = sum)
j <- round(j, digits)
j[]<-paste(j*p, decor, sep=" ")
farve <- rgb(red,green,blue, maxColorValue =255)
table <- tableGrob(j,
cols = k,
gpar.coretext = gpar(fontsize = 12),
gpar.coltext = gpar(fontsize = 12,col="white"),
gpar.rowtext = gpar(fontsize = 12, fontface="bold"),
gpar.corefill = gpar(fill = rgb(255,255,255, maxColorValue =255), alpha = 1, col = NA),
gpar.rowfill = gpar(fill = rgb(255,255,255, maxColorValue =255), alpha = 1, col = NA),
gpar.colfill = gpar(fill = 0, alpha = 1 ,col= "white"),
equal.width = TRUE,
show.rownames = TRUE,
show.rsep = TRUE,
show.hlines = TRUE,
show.csep = FALSE,
show.vlines = FALSE,
show.box = FALSE,
padding.h = unit(15, "mm"),
padding.v = unit(8, "mm"),
core.just = "center",
row.just = "left",
separator = farve)
hh <- grobHeight(table)
ww <- grobWidth(table)
border <- roundrectGrob(x=0.5, y=0.5, width=ww, height=hh,
default.units="npc",
r=unit(0.1, "snpc"),
just="centre",
name=NULL, gp=gpar(col="white", fill=farve, vp=NULL))
border2 <- roundrectGrob(x=0.5, y=0.5, width=ww, height=hh,
default.units="npc",
r=unit(0.1, "snpc"),
just="centre",
name=NULL, gp=gpar(fill=NA, col=farve, vp=NULL))
title <- textGrob(titel,
x=unit(0.5,"npc") -0.5*ww + unit(5, "mm"),
y=unit(0.5,"npc") +0.5*hh + unit(2, "mm"),
vjust=0,hjust=0, gp=gpar(fontsize=12, fontface="bold"))
footnote <- textGrob(note,
x=unit(0.5,"npc") - 0.5*ww + unit(5,"mm"),
y=unit(0.5,"npc") - 0.5*hh,
vjust=1, hjust=0,gp=gpar( fontsize=10))
svarpersoner <- textGrob(s,
x=unit(0.5,"npc") + 0.5*ww -unit(5, "mm"),
y=unit(0.5,"npc") + 0.5*hh + unit(2, "mm"),
vjust=0, hjust=1,gp=gpar( fontsize=10))
grid.newpage()
gt <- gTree(children=gList(border,table,border2, title, footnote, svarpersoner))
grid.draw(gt)
}
# Plot it
kryds.row(diamonds$color, diamonds$cut, titel="title", note="note") # plot 1
kryds.row(diamonds$cut, diamonds$color, titel="title", note="note") # plot 2
# Problems
#1: The title, note and the j in the row.text is very badly placed in plot 1 but not plot 2
#2 I cannot set the width and height of my table
I have not cleaned up in my code yet, so please bare with it!
The current version of gridExtra::tableGrob doesn't let you set the widths/heights. You can however try a different (experimental) version of tableGrob built from scratch using gtable.
#library(devtools)
#install_github("tablegrob", "baptiste")
require(tablegrob)
d <- iris[sample(seq.int(nrow(iris)), 6),]
grid.newpage()
pushViewport(viewport(height=0.8,width=0.9))
g2 <- tableGrob(d, rows=NULL,
widths=unit(1,"null"), heights=unit(1/(nrow(d)),"npc"))
grid.draw(g2)
grid.roundrect(y=unit(0,"line"), height=unit(1,"npc") +unit(1,"lines"),
just="bottom", r=unit(0.05, "snpc"))
Edit (08/2015): you can now edit the widths/heights, since grid.table is now based on gtable.
The solution I went with was to manipulate the length of the levels like this:
longest <- 0
longestnumber <- 0
for (i in 1:length(levels(x))){
if (longest < nchar(levels(x))[i]){
longest <- nchar(levels(x))[i]
longestnumber <- i
}
}
for (i in 1:(100-longest)){
levels(x)[longestnumber] <- paste(levels(x)[longestnumber], " ", sep="")
}
That way I can control the width of the table