I was hoping to expand on print to pdf file using grid.table in r - too many rows to fit on one page in order to add a title to the PDF
title <- "Table 1: Iris Data"
d <- iris[sample(nrow(iris), 187, TRUE),]
d$another <- "More Data"
d$column <- "Even More Will it Be off the Page"
The Provided Answer
library(gridExtra)
library(grid)
d <- iris[sample(nrow(iris), 187, TRUE),]
d$another <- "More Data"
d$column <- "Even More Will it Be off the Page"
tg <- tableGrob(d, rows = seq_len(nrow(d)))
fullheight <- convertHeight(sum(tg$heights), "cm", valueOnly = TRUE)
margin <- unit(0.51,"in")
margin_cm <- convertHeight(margin, "cm", valueOnly = TRUE)
a4height <- 29.7 - margin_cm
nrows <- nrow(tg)
npages <- ceiling(fullheight / a4height)
heights <- convertHeight(tg$heights, "cm", valueOnly = TRUE)
rows <- cut(cumsum(heights), include.lowest = FALSE,
breaks = c(0, cumsum(rep(a4height, npages))))
groups <- split(seq_len(nrows), rows)
gl <- lapply(groups, function(id) tg[id,])
pdf("multipage.pdf", paper = "a4", width = 0, height = 0)
for(page in seq_len(npages)){
grid.newpage()
grid.rect(width=unit(21,"cm") - margin,
height=unit(29.7,"cm")- margin)
grid.draw(gl[[page]])
}
## alternative to explicit loop:
## print(marrangeGrob(grobs=gl, ncol=1, nrow=1, top=NULL))
dev.off()
How can I change this code so that I can add title to the first page of the PDF?
Related
I have a table output in pdf format and I want to customise it to bring in line with a corporate theme. However, I'm new to this area in R and still finding it difficult to find my feet in adding logos.
My original dataset is composed of over 600 rows of data and is sensitive, so I've used a sample dataset to demonstrate. So far, I've got the following code using the grid and gridExtra packages:
library(grid)
library(gridExtra)
Data <- data.frame(Staff = c("Rod","Barry","Cheiny"),
M1 = c(50,40,55),
M2 = c(60,50,55),
M3 = c(55,50,45))
maxrow <- c(35);
npages <- ceiling(nrow(Data)/maxrow);
pdf("Data.pdf", height = 11, width = 10)
idx <- seq(1, maxrow)
grid.table(Data, rows = NULL, theme = ttheme_minimal())
grid.text("data",gp = gpar(fontsize = 12,fontface = "bold",alpha = 0.5),
vjust = -40,
hjust = -0.5)
for (i in 2:npages){
grid.newpage();
if(i*maxrow <= nrow(Data)) {
idx <- seq(1+((i-1)*maxrow), i*maxrow)
}else{
idx <- seq(1+((i-1)*maxrow), nrow(Data))
}
grid.table(Data, rows =NULL, theme = ttheme_minimal())
}
dev.off()
I'm getting a reasonable output at the moment, but I want to add a logo to each of the pages generated.
Anyone know how to add a logo that will repeat across all the pages?
It's easy to add elements with grid.draw(), but the design is up to you
library(grid)
library(gridExtra)
Data <- data.frame(Staff = c("Rod","Barry","Cheiny"),
M1 = c(50,40,55),
M2 = c(60,50,55),
M3 = c(55,50,45))
library(png)
img <- readPNG(system.file("img", "Rlogo.png", package="png"))
footer <- grobTree(rectGrob(y=0,vjust=0,gp=gpar(fill="grey97",col=NA), height=unit(1,"in")),
textGrob(y=unit(0.5,"in"), expression(Corporate^TM~line~(c))),
rasterGrob(img, x=1, hjust=1,y=unit(0.5,"in"),height=unit(1,"in")-unit(2,"mm")))
maxrow <- c(35);
npages <- ceiling(nrow(Data)/maxrow);
pdf("Data.pdf", height = 11, width = 10)
idx <- seq(1, maxrow)
grid.table(Data, rows = NULL, theme = ttheme_minimal())
grid.draw(footer)
grid.text("data",gp = gpar(fontsize = 12,fontface = "bold",alpha = 0.5),
vjust = -40,
hjust = -0.5)
for (i in 2:npages){
grid.newpage();
if(i*maxrow <= nrow(Data)) {
idx <- seq(1+((i-1)*maxrow), i*maxrow)
}else{
idx <- seq(1+((i-1)*maxrow), nrow(Data))
}
grid.table(Data, rows =NULL, theme = ttheme_minimal())
grid.draw(footer)
}
dev.off()
I am trying to generate a one file PDF with R.
I'm using pdf(), pie() and dev.off(), but all the pages in my PDF result are blank.
This is my R code:
library(jsonlite)
jsons_path <- "C:/color_uses/jsons"
setwd(jsons_path)
jsons <- list.files(jsons_path, pattern=NULL, all.files=FALSE,
full.names=FALSE)
pdf(file=paste(c("../pngs/pies.pdf"), collapse = ''), width = 1000, height = 600, onefile=T)
for(j in jsons){
color_uses <- fromJSON(j)
color_uses <- lapply(color_uses, function(x) {
x[sapply(x, is.null)] <- NA
unlist(x)
})
color_uses <- do.call("rbind", color_uses)
color_uses <- as.data.frame(color_uses)
if (is.vector(color_uses$probability)) {
color_uses$prob <- color_uses$probability
color_uses$hex <- rownames(color_uses)
color_uses <- color_uses[order(color_uses$probability),]
artist_name <- gsub(".json", "", j)
pie(color_uses$prob, col=color_uses$hex, labels=NA, main=paste(c("Colors of: ", artist_name), collapse= ''),
cex.lab=2, cex.axis=2, cex.main=2, cex.sub=2)
}
}
dev.off()
What can I do to fix the blank pages, so that I can make a pie chart on each page?
Your width and height is very high given that the units are specified as inches. The default value is 7 inches. So you should use a smaller value:
pdf(file = "path_to_your_file.pdf", width = 10, height = 6, onefile=TRUE)
# your code here
dev.off()
I have made a loop for making multiply plots, however i have no way of saving them, my code looks like this:
#----------------------------------------------------------------------------------------#
# RING data: Mikkel
#----------------------------------------------------------------------------------------#
# Set working directory
setwd()
#### Read data & Converting factors ####
dat <- read.table("Complete RING.txt", header =TRUE)
str(dat)
dat$Vial <- as.factor(dat$Vial)
dat$Line <- as.factor(dat$Line)
dat$Fly <- as.factor(dat$Fly)
dat$Temp <- as.factor(dat$Temp)
str(dat)
datSUM <- summaryBy(X0.5_sec+X1_sec+X1.5_sec+X2_sec+X2.5_sec+X3_sec~Vial_nr+Concentration+Sex+Line+Vial+Temp,data=dat, FUN=sum)
fl<-levels(datSUM$Line)
colors = c("#e41a1c", "#377eb8", "#4daf4a", "#984ea3")
meltet <- melt(datSUM, id=c("Concentration","Sex","Line","Vial", "Temp", "Vial_nr"))
levels(meltet$variable) <- c('0,5 sec', '1 sec', '1,5 sec', '2 sec', '2,5 sec', '3 sec')
meltet20 <- subset(meltet, Line=="20")
meltet20$variable <- as.factor(meltet20$variable)
AllConcentrations <- levels(meltet20$Concentration)
for (i in AllConcentrations) {
meltet.i <- meltet20[meltet20$Concentration ==i,]
quartz()
print(dotplot(value~variable|Temp, group=Sex, data = meltet.i ,xlab="Time", ylab="Total height pr vial [mm above buttom]", main=paste('Line 20 concentration ', meltet.i$Concentration[1]),
key = list(points = list(col = colors[1:2], pch = c(1, 2)),
text = list(c("Female", "Male")),
space = "top"), col = colors, pch =c(1, 2))) }
I have tried with the quartz.save function, but that just overwrites the files. Im using a mac if that makes any difference.
When I want to save multiple plots in a loop I tend to do something like...
for(i in AllConcentrations){
meltet.i <- meltet20[meltet20$Concentration ==i,]
pdf(paste("my_filename", i, ".pdf", sep = ""))
dotplot(value~variable|Temp, group=Sex, data = meltet.i ,xlab="Time", ylab="Total height pr vial [mm above buttom]", main=paste('Line 20 concentration ', meltet.i$Concentration[1]),
key = list(points = list(col = colors[1:2], pch = c(1, 2)),
text = list(c("Female", "Male")),
space = "top"), col = colors, pch =c(1, 2))
dev.off()
}
This will create a pdf file for every level in AllConcentrations and save it in your working directory. It will paste together my_filename, the number of the iteration i, and then .pdf together to make each file unique. Of course, you will want to adjust height and width in the pdf function.
I have recently started using tableGrob and gridextra to combine multiple plots and tables. i want mt tableGrob to have a footnote and title.
The following link answers that nicely:
Adding text to a grid.table plot
But in the above code the footnote gets truncated it its too long. Can someone please suggest an alternative so that the footnote automatically wraps to the next line once it had reached the end of the table? If it can wrap in the middle of the word that is fine as well.
test <- data.frame(boo = c(20,1), do = c(2,10), no = c(3,5),co = c('ed','jeff'))
t1 <- tableGrob(test)
tw <- convertWidth(unit(grobWidth(t1),'npc'),
"in", valueOnly = T)
title <- textGrob("Title is long too or is it??",gp=gpar(fontsize=15))
footnote <- textGrob("footnote is pretty longgg but not unusually longgggggggggkjwd jwkldn", x=0, hjust=0,
gp=gpar( fontface="italic"))
padding <- unit(0.5,"line")
t1 <- gtable_add_rows(t1,
heights = grobHeight(title) + padding,
pos = 0)
t1 <- gtable_add_rows(t1,
heights = grobHeight(footnote)+ padding)
t1 <- gtable_add_grob(t1, list(title, footnote),
t=c(1, nrow(t1)), l=c(1,1),
r=ncol(t1))
grid.arrange(t1)
I want this to work when I have a plot and a table in grid arrange as well. Please help.
I tried using strwrap and setting the width to grobWidth but it did not work for me.
the RGraphics book/package offers a possible solution,
splitString <- function (text, width) {
strings <- strsplit(text, " ")[[1]]
newstring <- strings[1]
linewidth <- stringWidth(newstring)
gapwidth <- stringWidth(" ")
availwidth <- convertWidth(width, "in", valueOnly = TRUE)
for (i in 2:length(strings)) {
width <- stringWidth(strings[i])
if (convertWidth(linewidth + gapwidth + width, "in",
valueOnly = TRUE) < availwidth) {
sep <- " "
linewidth <- linewidth + gapwidth + width
}
else {
sep <- "\n"
linewidth <- width
}
newstring <- paste(newstring, strings[i], sep = sep)
}
newstring
}
tit <- "Title is long too or is it??"
foot <- "footnote is pretty longgg but not unusually longgggggggggkjwd jwkldn"
footnote <- textGrob(splitString(foot, sum(t1$widths)))
title <- textGrob(splitString(tit, sum(t1$widths)))
t1 <- gtable_add_rows(t1, heights = grobHeight(footnote))
t1 <- gtable_add_rows(t1, heights = grobHeight(title), 0)
t1 <- gtable_add_grob(t1, list(title, footnote),
t=c(1, nrow(t1)), l=1, r=ncol(t1))
grid.draw(t1)
I built a function for quickly plotting a table with a lot of help from this answer from #baptiste.
plotTable<-function(data, title=NULL, footnote=NULL, fontsize=9, plotIt=TRUE, show.rownames=TRUE){
# Generic method to plot tabular data
# Built the base table with/without row names
if(show.rownames){
table <- tableGrob(data, theme=ttheme_default(
core=list(fg_params=list(fontsize=fontsize)),
colhead=list(fg_params=list(fontsize=fontsize)),
rowhead=list(fg_params=list(fontsize=fontsize))))
} else{
table <- tableGrob(data, theme=ttheme_default(
core=list(fg_params=list(fontsize=fontsize)),
colhead=list(fg_params=list(fontsize=fontsize)),
rowhead=list(fg_params=list(fontsize=fontsize))), rows=NULL)
}
# Set the padding
padding <- unit(0.5,"line")
# Add the title if it's not NULL
if(!is.null(title)){
title.grob <- textGrob(title, gp=gpar(fontsize=fontsize+3))
table <- gtable_add_rows(table, heights = grobHeight(title.grob) + padding, pos = 0)
table <- gtable_add_grob(table, list(title.grob), t=1, l=1, r=ncol(table))
}
# Add the footnote if it's not NULL
if(!is.null(footnote)){
footnote.grob <- textGrob(footnote, x=0, hjust=0, gp=gpar(fontsize=fontsize, fontface="italic"))
table <- gtable_add_rows(table, heights = grobHeight(footnote.grob)+ padding)
table <- gtable_add_grob(table, list(footnote.grob), t=nrow(table), l=1, r=ncol(table))
}
# Either plot it or return the grob
if(plotIt) grid.arrange(table) else return(table)
}
But sometimes my title is longer than the actual table and it's getting cut off.
libs <- c("data.table", "grid", "gridExtra", "gtable")
lapply(libs, library, character.only = TRUE)
mytable <- data.table(x=c(1,2,3), y=c(3,2,1))
plotTable(mytable, title="Hello World")
How do I fix this?
You can set the table widths manually, but you'll need to decide which column(s) should be expanded and by how much. I guess a reasonable way to redistribute the widths is to add the same margin to each column, so that the total space gained accounts for the extra room needed for the title.
library(gridExtra)
d <- head(iris[,1:2])
table <- tableGrob(d, rows=NULL)
library(grid)
library(gtable)
title <- textGrob("my long title goes here",gp=gpar(fontsize=30))
padding <- unit(1,"line")
table <- gtable_add_rows(table,
heights = grobHeight(title) + padding,
pos = 0)
table <- gtable_add_grob(table, title,
t=1, l=1,
r=ncol(table))
# check whether the table width is smaller than the title width
missed <- convertWidth(sum(table$widths), "in", valueOnly = TRUE) -
convertWidth(grobWidth(title), "in", valueOnly = TRUE)
if(missed < 0 ) # need to do something about it
table$widths <- table$widths + unit(abs(missed)/ncol(table), "in")
grid.newpage()
grid.draw(table)
another option, if you don't want the cells to be resized, is to turn clipping off,
table$layout$clip <- "off"