Xtable two columns using longtable customizations - r

This is a continuation of a question I posted earlier. I have a code.Rnw file in RStudio which I knit into a code.tex file using knit("code.Rnw") command.
I have a data frame that I am printing using the xtable command. In the example below, it is 20 rows. However, to save space, I am printing it out as two columns, each with 10 rows.
Below is my code:
\documentclass[11pt, a4paper]{article}
\usepackage[margin=3cm]{geometry}
\usepackage{longtable}
\begin{document}
<<echo=FALSE,results='asis'>>=
library(xtable)
set.seed(1)
spaceCol = rep(" ",10)
df1 = data.frame(student = letters[1:10], vals=runif(10, 1, 10))
df2 = data.frame(student = letters[11:20], vals=runif(10, 1, 10))
dfFull = data.frame(df1,spaceCol,df2)
names(dfFull) = c(" ","% Correct"," "," ", "% Correct")
row.names(dfFull) = NULL
x.big <- xtable(dfFull, label ='tabtwo',caption ='Caption for table with student scores')
print(x.big, tabular.environment ='longtable', floating = FALSE, include.rownames=FALSE)
#
\end{document}
This is what the output looks like:
I like the aesthetics of this output, especially because in the longtable format, this output will automatically page-break if need be. However, what I am trying to improve, is to make it more easy to visualize that this output is really two distinct columns.
To do that, I would like to add a space between the two columns, so the output looks more as follows:
However, if that proves impossible, then I could consider something like adding a vertical line to distinguish the two columns, as shown below:
How might this be possible given my limitation in using xtable?

\documentclass[11pt, a4paper]{article}
\usepackage{subfig}
\begin{document}
<<echo = FALSE>>=
library(xtable)
opts_chunk$set(
echo = FALSE,
results = 'asis'
)
set.seed(1)
mynames <- c("", "% Correct")
df1 = data.frame(letters[1:10], runif(10, 1, 10))
df2 = data.frame(student = letters[11:20], vals=runif(10, 1, 10))
colnames(df1) <- mynames
colnames(df2) <- mynames
#
\begin{table}\centering
\subfloat{
<<>>=
print(xtable(df1), floating = FALSE, include.rownames = FALSE)
#
} \hspace{2cm}
\subfloat{
<<>>=
print(xtable(df2), floating = FALSE, include.rownames = FALSE)
#
}
\caption{Caption for table with student scores} \label{tabtwo}
\end{table}
\end{document}
The only drawback is, that you cannot use longtable with this approach.
UPDATE: Here is an alternative that makes use of longtable. The trick is to use xtable for the contents of the table only and build the headline by hand, so you have full control over all lines etc. I decided to use an empty column for the space because making column 2 wider would make the horizontal lines look ugly.
\documentclass{article}
\usepackage{longtable}
\begin{document}
\thispagestyle{empty}
<<echo = FALSE>>=
library(xtable)
opts_chunk$set(
echo = FALSE,
results = 'asis'
)
set.seed(1)
df1 = data.frame(letters[1:10], runif(10, 1, 10))
df2 = data.frame(student = letters[11:20], vals=runif(10, 1, 10))
dfFull <- cbind(df1, NA, df2)
#
\begin{longtable}{lrl#{\hskip 2cm}lr} \cline{1-2} \cline{4-5}
& \% Correct & & & \% Correct \\ \cline{1-2} \cline{4-5}
<<>>=
print(xtable(dfFull), only.contents = TRUE, include.rownames = FALSE, include.colnames = FALSE, hline.after = NULL)
#
\cline{1-2} \cline{4-5}
\caption{Caption for table with studen scores} \label{tabtwo}
\end{longtable}
\end{document}
UPDATE2: Finally, a solution that uses longtable and doesn't involve creating half of the table "by hand". The trick is to remove all horizontal lines (hline.after = NULL) and than add \clines where required using add.to.row (inspired by this question).
\documentclass{article}
\usepackage{longtable}
\begin{document}
\thispagestyle{empty}
<<echo = FALSE, results = 'asis'>>=
library(xtable)
set.seed(1)
df1 = data.frame(letters[1:10], runif(10, 1, 10))
df2 = data.frame(letters[11:20], runif(10, 1, 10))
dfFull <- cbind(df1, NA, df2)
# To test "longtable", rbind data several times:
multiply <- 5
dfFull <- do.call("rbind", replicate(multiply, dfFull, simplify = FALSE))
colnames(dfFull) <- c("", "% Correct", "", "", "% Correct")
print(xtable(dfFull,
caption = "Caption for table with student scores",
label = "tabtwo",
align = c("l", # ignored (would apply to colnames)
"l", "r",
"l#{\\hskip 2cm}", # space between blocks
"l", "r")),
include.rownames = FALSE,
include.colnames = TRUE,
hline.after = NULL, # Remove all default lines. A line after the very last row remains, which is automatically added when using "longtable".
tabular.environment = "longtable",
floating = FALSE,
add.to.row = list(
pos = list(-1, 0),
command = rep("\\cline{1-2} \\cline{4-5}", 2))
)
#
\end{document}

Related

How can I make a collapse with glue package using RMarkdown?

I've been trying to automate the results of some df table in latex using the glue and stargazer packages, but I haven't had any results (what I want is for the meaning "^{*}" to appear next to each value as it is in the table) to use then RMarkdown.
What I want to get:
My current ugly and error-prone fix:
library(dplyr)
library(glue)
library(stargazer)
X1 = c(4.70e1, 4.72e1, 4.76e1, 2.73e20)
X2 = c(4.67e1, 4.69e1, 4.77e1, 2.05e20)
tab.out = data.frame(X1, X2)
tab.out$max<-apply(tab.out, 1, max)
one = "1"
n.tab = tab.out %>%
mutate(test1 = if_else(tab.out$X2 < tab.out$max,
glue("\\textsuperscript{*} is $<<one>>$.", .open = "<<", .close = ">>"), #It doesn't work with ^{*}
glue("")))
Note: one was just to test the collapse because I tried glue_data as well as glue_collapse and it didn't work.
On the other hand, assuming the collapse works, how would I do to debug the latex code right? Because I tried with stargazer, xtable and textreg but in each of the functions it doesn't recognize "\, }, ^{*}".
n.tab = n.tab[c(1,2,4)]
stargazer(n.tab, summary = F, header = F)
What I got ?
I achieved this using the paste0 function as mentioned here and on the recommendation of #stefan but now I would like to automate the same function for n-columns
library(dplyr)
col.nam = c("AIC(n)", "HQ(n)", "SC(n)", "FPE(n)")
tab.out = data.frame(col.nam, X1, X2)
n.tab = tab.out %>%
mutate(test1 = if_else(tab.out$X1 < tab.out$X2,
paste0(X1,"$^{*}$"),
paste0(X1)),
test2 = if_else(tab.out$X2 < tab.out$X1,
paste0(X2,"\\textsuperscript{*}"),
paste0(X2)))%>%
select(col.nam, test1, test2)
colnames(n.tab) = c("Parámetros", "Lag 1", "Lag 2")
print(xtable::xtable(n.tab,
header = F,
caption = "asdasdasdasd",
label="table:tb1",
caption.placement = "top",
align="llcc"),
hline.after = c(-1,0),
include.rownames=FALSE,
include.colnames = TRUE,
add.to.row = list(pos = list(nrow(n.tab)),
command = paste("\\hline \n",
"\\multicolumn{3}{l}{\\footnotesize{$^{*}$Indica el orden de retraso seleccionado}} \\\\",
"\\multicolumn{3}{l}{\\footnotesize{\\textit{Elaboración: Los autores}}}",
sep = "")), comment=FALSE,
sanitize.text.function = function(x){x})

How to parameterize the inline code, text, together with R code chunk in Rmarkdown

In my Rmarkdown report, most of sections have the same text, inline code and R code chunk. Is it possible to parameterize them? For example the below image, is it possible to use something like for loop to produce them instead of repeating similar code 3 times?
In main RMD file,
library(tidyverse)
dat <- tibble(
id = 1:3,
fruit = c("apple", "orange", "banana"),
sold = c(10, 20, 30)
)
res <- lapply(dat$id, function(x) {
knitr::knit_child(
'template.Rmd', envir = environment(), quiet = TRUE
)
})
cat(unlist(res), sep = '\n')
In template.RMD,
current_dat <- filter(dat, id == x)
# Section: `r current_dat$fruit`
current_dat %>%
ggplot(aes(x = fruit, y = sold)) + geom_col()
IMHO, the simplest wat to achieve this is to use results = 'asis' and cat() below is a minimal RMarkdown file.
---
title: "Minimal example"
---
```{R results = "asis"}
for (i in 1:3) {
x <- runif(10)
cat("# section", floor(i), "\n")
plot(x)
# line break
cat("\n\n")
}
```

Shade table with extraKable in RMarkdown for pdf using dplyr mutate?

I am wanting to apply different color shading to a table based on different value sets. I am creating this table in Rmarkdown using kableExtra. I want values between 0 and <.10 to be left alone. Values >=.10 and <.20 to be shaded yellow. and values >=.20 to be shaded red.
df
name category 1 categry 2 category a category b
ab .01 .45 .19 .09
410 .12 .01 .05 .66
NW 5th .25 .22 .01 .16
This is what I have been making my existing table with:
library(knitr)
library(dplyr)
kable(df, caption = "warning values", digits = 2, format = "latex",
booktabs = T)%>%
kable_styling(latex_options = c("striped"))%>%
landscape()%>%
row_spec(0, angle = 45)
I'm not sure how to use the mutate and cel_spec functions to apply to the entire table. The table columns and row names change dynamically with every report fyi.
EDIT: Martin's answer works great. Until I tried to clean up my numbers. My actual input file has more digits, like Martin's answer. It also has file and row names that include an underscore. (That caused issues when using this answer, but I found a workaround.)
#replace any "_" with escaped "\\_" for magrittR/latex compatability
names(df) <- gsub(x = names(df), pattern = "\\_", replacement =
"\\\\_")
df$name <- gsub('\\_', '\\\\_', df$name)
#format numbers
df <- format(df, digits=0, nsmall=3, scientific = FALSE)
The replacement works fine, its the number formatting that breaks the answer. Everything still executes just fine, but I lose the colorized table.
Thoughts?
Here is way to do this. Notice that I used the compund assignment operator from magrittr.
---
title: test
output: pdf_document
---
```{r, echo = F, warning = F, message = F}
library(knitr)
library(dplyr)
library(kableExtra)
library(magrittr)
df <- data.frame(A = runif(4, 0, 1), B = runif(4, 0, 1), row.names = letters[1:4])
paint <- function(x) { # our painting function
ifelse(x < 0.1, "white", ifelse(x < 0.2, "yellow", "red"))
}
df %<>%. # compound assignment operator
mutate_if(is.numeric, function(x) { # conditional mutation, if the column type is numeric
cell_spec(x, background = paint(x), format = "latex")
})
kable(df, caption = "warning values", digits = 2, format = "latex",
booktabs = T, escape = F) %>%
landscape()%>%
row_spec(0, angle = 45)
```

Pixiedust table in loop in r markdown not rendering

Relevant to the problem, I have a dataset with factors of states ("Massachusetts", "California", etc) and 2 fields of values. I would like to create a graph for each state with a table below it showing the associated fields and the difference between those fields.
I found that using a loop seems to require a results = 'asis' option and a cat(" \n") at the end of the loop to print the images. That works OK. However, the only way I can seem to get a table is if I use xtable or kable. I would like to use pixiedust to color and otherwise beautify the table.
Here is a minimal example:
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(pixiedust)
library(ggplot2)
library(knitr)
library(xtable)
df <- data.frame(state = c("MA", "CA"), last_year = c(105, 90), this_year = c(110, 85))
```
# Here is the loop
```{r loops, results = 'asis', echo = FALSE}
for (i in 1:nrow(df)){
state_dat <- df[i,]
p1 <- ggplot(state_dat, aes(last_year, this_year)) +
geom_point()
print(p1)
cat(" \n")
tab <- data.frame(last_year = state_dat$last_year, this_year = state_dat$this_year, yoy_percent = 100*(state_dat$this_year - state_dat$last_year)/state_dat$last_year)
dust(tab) %>%
sprinkle(rows = 1, bg = "orchid")
cat(" \n")
print(kable(tab, row.names = FALSE, align = "c"))
cat(" \n")
print(xtable(tab, auto = TRUE),type = "html", comment = FALSE, include.rownames = F)
cat(" \n")
}
```
I also tried assigning the result of the dust commands to an object and printing that:
pixie <- dust(tab) %>%
sprinkle(rows = 1, bg = "orchid")
print(pixie)
cat(" \n")
to no avail.
Can pixiedust tables be produced as html in a chunk with option asis? Is there another workaround to produce a table and a graph in a loop?
Yes, this can be done. To get there, you have to turn off the asis printing in the print.dust method. This can be done with:
dust(tab) %>%
sprinkle(rows = 1, bg = "orchid") %>%
print(asis = FALSE) %>%
cat()
In time, I hope to come up with a better solution.

Table in r with multiple sub rows and write to pdf

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)
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.
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")
```

Resources