Table in r with multiple sub rows and write to pdf - r

Question

Is it possible to generate a table in R with multiple rows correspondng to a single row? And write the resultant table to a pdf. The sample table is as below.
Is it possible to join two seperate tables in the way showed in the image.
Sample code for the two tables are given below
tab1="Test Description
1 test1 description
2 test2 description"
table1 <-read.table(text = tab1,header = TRUE)
tab21="Cause Probability Feedback
1 cause1 .5 positive
2 Cause2 .2 negative
3 Cause3 .1 negative
4 Cause4 .2 negative"
table2 <-read.table(text = tab21,header = TRUE)
tab22="Cause Probability Feedback
1 cause1 .7 positive
2 Cause2 .2 negative
3 Cause3 .1 negative"
table3 <-read.table(text = tab22,header = TRUE)

Answer 1

It is a little bit tricky, but I'd take advantage of the fact that cells with NAs are printed as empty by the print.xtable-function. The cells are not truly 'merged', but it looks like it when the contents are aligned to the top.
Basically the steps are:
Generate a suitable data.frame in R
Print this as a .tex compatible table using print.xtable from the package 'xtable'
Use Sweave/knitr/etc to generate a suitable .tex
tools::texi2pdf will then convert your .tex to a suitable .pdf
Here are the files, you need to only source the RunSweave.R in your R terminal (and make sure you have LaTeX installed along with the required packages, i.e. 'xtable and have the files in a single folder; this was run in Windows).
File StackExampleCode.R:
# StackExampleCode.R
library(xtable)
# A work-around by setting rows in the multi-row to NA after the initial top-justified line
header <- data.frame(test = "Tests", det = "Details", cause = "Cause", prob = "Probability", fb = "Feedback")
# Filling the fields for these is something you'd probably want to do in R in a more sophisticated manner
test1 <- data.frame(
test = c("Test 1", NA, NA, NA, NA),
det = c("Description", NA, NA, NA, NA),
cause = c("Cause 1", NA, paste("Cause", 2:4)),
prob = c(".5", NA, ".2", ".1", ".2"),
fb = c("positive", NA, "negative", "negative", "negative")
)
test2 <- data.frame(
test = c("Test 2", NA, NA, NA),
det = c("Description", NA, NA, NA),
cause = c(paste("Cause", 1:3), NA),
prob = c(".7", ".1", ".2", NA),
fb = c("positive", "negative", "negative", NA)
)
# Bind it all together, you probably want something similar if it's automatic data you're generating
tab <- rbind(header, test1, test2)
File StackExampleRnw.Rnw:
% StackExampleRnw.Rnw
% Note the different comment char, writing .tex here
\documentclass{article}
\begin{document}
<<echo=FALSE, results=tex>>=
# Printing the table
print(
xtable(tab,
align = "|l|l|l|l|l|l|" # Create the desired vertical lines and text alignments ala LaTeX; left align with vertical lines in-between each column)
),
add.to.row = list( # Add horizontal lines to correct spots, should be adjusted according to the desired data
pos = list(-1, 1, 6, nrow(tab)),
command = c("\\hline \n", "\\hline \n", "\\hline \n", "\\hline \n") # Horizontal lines and a neater formatting of output using a linechange
),
include.rownames = FALSE, # Don't include the rownames (which would be just numbers)
include.colnames = FALSE, # Don't include the rownames, these were already included as if it was an ordinary table row
hline.after = NULL # Suppress the empty horizontal line that is intended for an automated caption
)
#
\end{document}
File RunSweave.R:
# RunSweave.R
# Run the code
source("StackExampleCode.R")
# Bundle R code with LaTeX
Sweave("StackExampleRnw.Rnw")
# .tex -> .pdf
tools::texi2pdf("StackExampleRnw.tex")
Here's what it looks like for me in StackExampleRnw.pdf:
Alternatively, you can directly access the table in .tex in the file StackExampleRnw.tex and do some additional formatting if you're comfortable with it. Above doesn't require any additional tinkering in .tex, but you need to make sure you put the horizontal lines and NAs to correct places.
If you're not comfortable with .tex, the print.xtable-function has plenty of parameters available for further formatting. If the partial horizontal lines are really important for you in the three columns to the right, I'd probably split this into two tables and then just glue them together horizontally and have the right one with a horizontal line in each row.

Answer 2

I would have liked to accomplish this in pixiedust by merging some cells, but it appears I have a flaw in pixiedust that doesn't allow for vertical borders on merged rows. The workaround uses Teemu's approach of setting the cells we don't wish to view to NA and directing them to be printed as empty characters.
library(dplyr)
library(pixiedust)
table2$Test <- "test1"
table3$Test <- "test2"
bind_rows(
right_join(table1, table2),
right_join(table1, table3)
) %>%
mutate(Description = as.character(Description)) %>%
group_by(Test) %>%
mutate(Description = ifelse(duplicated(Description), NA, Description)) %>%
ungroup() %>%
mutate(Test = ifelse(duplicated(Test), NA, Test))%>%
dust(float = FALSE) %>%
sprinkle(cols = 1:2,
rows = c(4, 7),
border = "bottom") %>%
sprinkle(cols = 1:2,
rows = 1,
border = "top") %>%
sprinkle(cols = 1:2,
border = "left",
na.string = "") %>%
medley_all_borders(cols = 3:5) %>%
medley_all_borders(part = "head") %>%
sprinkle_print_method("latex")
A full, working RMD file would be:
---
title: "Untitled"
output: pdf_document
header-includes:
- \usepackage{amssymb}
- \usepackage{arydshln}
- \usepackage{caption}
- \usepackage{graphicx}
- \usepackage{hhline}
- \usepackage{longtable}
- \usepackage{multirow}
- \usepackage[dvipsnames,table]{xcolor}
---
```{r, echo = FALSE, message = FALSE, warning = FALSE}
library(dplyr)
library(pixiedust)
tab1="Test Description
1 test1 description
2 test2 description"
table1 <-read.table(text = tab1,header = TRUE)
tab21="Cause Probability Feedback
1 cause1 .5 positive
2 Cause2 .2 negative
3 Cause3 .1 negative
4 Cause4 .2 negative"
table2 <-read.table(text = tab21,header = TRUE)
tab22="Cause Probability Feedback
1 cause1 .7 positive
2 Cause2 .2 negative
3 Cause3 .1 negative"
table3 <-read.table(text = tab22,header = TRUE)
```
```{r, echo = FALSE, message = FALSE, warning = FALSE}
table2$Test <- "test1"
table3$Test <- "test2"
bind_rows(
right_join(table1, table2),
right_join(table1, table3)
) %>%
mutate(Description = as.character(Description)) %>%
group_by(Test) %>%
mutate(Description = ifelse(duplicated(Description), NA, Description)) %>%
ungroup() %>%
mutate(Test = ifelse(duplicated(Test), NA, Test))%>%
dust(float = FALSE) %>%
sprinkle(cols = 1:2,
rows = c(4, 7),
border = "bottom") %>%
sprinkle(cols = 1:2,
rows = 1,
border = "top") %>%
sprinkle(cols = 1:2,
border = "left",
na.string = "") %>%
medley_all_borders(cols = 3:5) %>%
medley_all_borders(part = "head")
```