After days trying to find a solution, I give up and ask for help.
I decided to use R Markdown very recently. While I can render plots as I want, I cannot succeed in rendering my tables in a pdf doc properly.
Here the corresponding [EDITED]code:
---
title: "My_title"
output:
pdf_document: default
html_document:
df_print: paged
params:
date: "!r Sys.Date()"
---
```{r library, echo=F, message=F, warning=F, paged.print=FALSE}
suppressMessages(library("knitr"))
suppressMessages(library(reshape2))
suppressMessages(library(splines))
suppressMessages(library(kableExtra))
suppressMessages(library(gplots))
```
```{r, setup, echo = F}
opts_knit$set(root.dir = "my_path")
knitr::opts_chunk$set(echo = F)
```
```{r}
dt <- expand.grid(Region=c("a","b","c"), Country=c("d","e","f"), Cancer= c("All", "CRC", "Breast"),
age.1.1=1:2,
age.1.2=1:2,
age.1.3=1:2)
```
```{r Table_1, INCLUDE = TRUE}
cancer.lab <- c("All", "CRC", "Breast")
for (i in 1:3){
b <- dt[dt$Cancer==cancer.lab[i],]
b <- b[,-3]
t <- kable(b, format = ,caption = "Fig", row.names = F) %>%
kable_paper() %>%
kable_styling(font_size = 9) %>%
add_header_above(c(" " = 2, "1998" = 3))
print(t)
}
```
Again I am new and I surely miss something.
I use Mac if it may explain something.
Thank you for your help.
Sophie.
I think this is the same issue as dealt with here: https://stackoverflow.com/a/53632154/2554330. The problem is that you need to use knit_print to print the tables, but you can't do that in a loop.
So if you change the last code chunk to this, it should work:
```{r Table_1, INCLUDE = TRUE}
results <- c()
cancer.lab <- c("All", "CRC", "Breast")
for (i in 1:3){
b <- dt[dt$Cancer==cancer.lab[i],]
b <- b[,-3]
t <- kable(b, format = ,caption = "Fig", row.names = F) %>%
kable_paper() %>%
kable_styling(font_size = 9) %>%
add_header_above(c(" " = 2, "1998" = 3))
results <- c(results, knit_print(t))
}
asis_output(results)
```
Related
I am trying to print gtExtras::gt_plt_winloss tables in a for loop in a paged HTML RMarkdown document. Outside of a loop, the tables are rendering as expected. Inside of a loop, the table preview is as expected in the console but prints to PDF partially in raw and partially in rendered HTML. I would appreciate any help figuring out why the rendering is going wrong in the loop!
---
title: example
output:
pagedown::html_paged:
toc: true
toc_depth: 1
self_contained: true
number_sections: false
knit: pagedown::chrome_print
paged-footnotes: true
---
set.seed(37)
data_in <- dplyr::tibble(
grp = rep(c("A", "B", "C"), each = 10),
wins = sample(c(0,1,.5), size = 30, prob = c(0.45, 0.45, 0.1), replace = TRUE)
) %>%
dplyr::group_by(grp) %>%
dplyr::summarize(wins=list(wins), .groups = "drop")
win_table <- data_in %>%
gt() %>%
gt_plt_winloss(wins)
Renders as expected in console and in PDF:
```{r, results = 'asis'}
win_table %>%
tab_header("no loop")
```
winloss table outside of loop
Renders fine in console but messed up in PDF:
```{r, results = "asis"}
for(i in 1:2) {
win_table %>%
tab_header(paste("looped attempt", i)) %>%
print()
}
```
problems rendering winloss inside of loop
We may use
```{r, results = "asis"}
for(i in 1:2) {
out <- win_table %>%
tab_header(paste("looped attempt", i))
cat(knitr::knit_print(out))
}
```
-output
I've been trying to follow this tutorial: generating reports
I've been able to get the suggested code to run successfully and produces PDFs without issue. When I try to run the Shiny app using my own .Rmd file, it works fine the first time and produces a PDF where desired. On the second and any additional runs, the file generation fails with ! LaTeX Error: Unknown float option 'H'.
I've tried mentioning the {float} package in the YAML header of the markdown file without any improvement. The only success seems to be removing all of the r code blocks, which leaves my document looking pretty sparse.
Here is app.R:
shinyApp(
ui = fluidPage(
sliderInput("slider", "Slider", 1, 100, 50),
dateInput("dateinput", "Select a date"),
downloadButton("report.pdf", "Generate report")
),
server = function(input, output) {
output$report.pdf <- downloadHandler(
filename = "report.pdf",
content = function(file) {
tempReport <- file.path(tempdir(), "deviants.Rmd")
file.copy("deviants.Rmd", tempReport, overwrite = TRUE)
params <- list(n = input$slider, d = input$dateinput)
print(class(params$n))
print(class(params$d))
print(params)
rmarkdown::render(tempReport, output_file = file,
params = params,
envir = new.env(parent = globalenv())
)
}
)
}
)
and deviants.Rmd:
---
output: pdf_document
always_allow_html: yes
params:
n: NA
d: NA
header-includes:
- \usepackage{booktabs}
- \usepackage{sectsty} \subsectionfont{\centering}
- \usepackage{sectsty} \sectionfont{\centering}
- \usepackage{float{
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(grid)
library(png)
library(dplyr)
```
```{r echo=FALSE, results='asis'}
cat(params$n)
cat(params$d)
```
```{r echo=FALSE}
sampleMetrics <- data.frame(
Sample = c("Threshold","A","2","4","11","C","DEF"),
Length = c(">= 6", 10, 11, 11, 11, 11, 12),
Experiment1 = c(">= 10000",5696,8006,6675,9477,5028,7093),
Experiment2 = c(">= 10000", 21223, 27890, 34623, 24152, 25716, 45187),
Sum = c(">=20000", 28409, 41895, 46181, 34129, 12244, 51910),
Total1 = c("N/A", 41382, 132670, 78271, 89930, 98788, 13015),
Total2 = c("N/A", 43170, 53280, 57568, 46584, 51156, 55045),
stringsAsFactors = FALSE
)
super_cell_spec <- function(data, threshold) {
cell_spec(as.numeric(data), "latex", background = ifelse(
as.numeric(data) >= threshold, "#45ff41", "#ff4242"))
}
sampleMetrics$Length[-1] <- super_cell_spec(sampleMetrics$Length[-1], 6)
sampleMetrics$Experiment1[-1] <- super_cell_spec(
sampleMetrics$Experiment1[-1], 10000)
sampleMetrics$Experiment2[-1] <- super_cell_spec(
sampleMetrics$Experiment2[-1], 10000)
sampleMetrics$Sum[-1] <- super_cell_spec(sampleMetrics$Sum[-1], 20000)
sampleMetrics[1,] <- cell_spec(sampleMetrics[1,], "latex",
background = "#afafaf")
sampleMetrics%>%
kable("latex", booktabs = F, escape = F,
col.names = linebreak(c("Sample",
"Length", "Experiment 1",
"Experiment 2","Sum",
"Total\n1", "Total\n2"),
align = "c")) %>%
kable_styling(latex_options = "scale_down")
```
I definitely wouldn't be as confused if it didn't work flawlessly the first time around. Maybe something to do with the envir = new.env(parent = globalenv()) in app.R? Thanks for any thoughts.
Managed to fix this by adding additional packages, mostly through the trial and error of ! Undefined control sequence errors. It would report an issue with multirow and I would look up the right latex package to include.
In the end, my YAML Rmarkdown header looked like:
---
output: pdf_document
always_allow_html: yes
params:
d: NA
st: NA
header-includes:
- \usepackage[table]{xcolor}
- \usepackage{makecell, tabularx, float, multirow, pgfplots}
- \usepackage{booktabs}
- \usepackage{sectsty} \subsectionfont{\centering}
- \usepackage{sectsty} \sectionfont{\centering}
---
This fixed the problem.
I am trying to create a table in RMarkdown that looks similar to the following example:
---
title: "Example"
output: pdf_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
```
```{r cars, echo=FALSE, message=FALSE, warning=FALSE, results='asis'}
library(Hmisc)
latex(mtcars, file = "", cgroup = c("mpg", "cyl"), n.cgroup = c(1,10))
```
I would like to group columns 2 through 10. Any ideas on how I can accomplish this with the Hmisc package or any other R package?
I think just using a blank header name for the first column gives you what you want:
latex(mtcars, file = "", cgroup = c("", "cyl"), n.cgroup = c(1,10))
Result:
Using my package:
library(huxtable)
hux_cars <- as_hux(mtcars, add_colnames = TRUE)
hux_cars <- insert_row(hux_cars, c('mtcars', 'cyl', rep('', 9)))
colspan(hux_cars)[1, 2] <- 10
align(hux_cars)[1, 2] <- 'centre'
bold(hux_cars)[1, ] <- TRUE
position(hux_cars) <- 'left'
quick_pdf(hux_cars)
Which produces:
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.
I am working on creating a dynamic rmarkdown document. The end result should create a tab for each 'classification' in the data. Each tab should have a datatable, from the DT package, with the data printed to it. Below is the code I have been using:
---
output: html_document
---
# Setup{.tabset}
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
library(knitr)
library(DT)
```
```{r data.setup}
set.seed = 1242
rows = 64
data.1 = runif(rows, 25, 75)
data.2 = runif(rows, .01, 1)
data.3 = runif(rows, 1, 10)
classification = c("A", "B", "C", "D")
df = data.frame(cbind(data.1 = data.1, data.2 = data.2, data.3 = data.3, classification = classification))
df$data.1 = as.numeric(df$data.1)
df$data.2 = as.numeric(df$data.2)
df$data.3 = as.numeric(df$data.3)
```
```{r results= 'asis'}
for(j in levels(df$classification)){
df.j = df[df$classification == j, ]
cat(paste("\n\n## Classification: ", j, "##\n"))
w = datatable(df.j)
#datatable(df.j)
print(w)
}
```
Notice I have commented out straight calls to the datatable function, those were not printing to rmarkdown. The results of the call as written generate an html document with the correct tabs, but no datatables in them. Additionally, the datatables actually display in my RStudio session with the correct subsetting. As a test, I tried achieving the goal using the kable function from knitr, and the tables were printed in their appropriate tabs, unfortunately, kable does not have all the functionality required.
This is not a complete answer as some of this is still puzzling me, but at least this is good enough to get you going while I try to understand some more.
---
output: html_document
---
# Setup{.tabset}
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
library(knitr)
library(DT)
```
```{r data.setup}
set.seed <- 1242
rows <- 64
data.1 <- runif(rows, 25, 75)
data.2 <- runif(rows, .01, 1)
data.3 <- runif(rows, 1, 10)
classification <- c("A", "B", "C", "D")
df <- data.frame(cbind(data.1 = data.1, data.2 = data.2, data.3 = data.3, classification = classification))
df$data.1 <- as.numeric(df$data.1)
df$data.2 <- as.numeric(df$data.2)
df$data.3 <- as.numeric(df$data.3)
```
```{r include = FALSE}
# Why, oh why do I need this chunk?
datatable(df)
```
```{r results = 'asis'}
for(j in unique(df$classification)){ # You were using level() here, so your for-loop never got off the ground
df.j <- df[df$classification == j, ]
cat(paste("\n\n## Classification: ", j, "##\n"))
print( htmltools::tagList(datatable(df.j)) )
}
The third chunk is required for this to work, I'm not yet sure why.
Reaching here by googling the same question. This has worked for me: https://gist.github.com/ReportMort/9ccb544a337fd1778179.
Basically, generate a list of rendered tibbles and manually call knit.
Here is a working Rmd based on your example, using the technique found in the above link:
---
output: html_document
---
# Setup{.tabset}
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
library(knitr)
library(DT)
```
```{r data.setup}
set.seed <- 1242
rows <- 64
data.1 <- runif(rows, 25, 75)
data.2 <- runif(rows, .01, 1)
data.3 <- runif(rows, 1, 10)
classification <- c("A", "B", "C", "D")
df <- data.frame(cbind(data.1 = data.1, data.2 = data.2, data.3 = data.3, classification = classification))
df$data.1 <- as.numeric(df$data.1)
df$data.2 <- as.numeric(df$data.2)
df$data.3 <- as.numeric(df$data.3)
```
```{r include = FALSE}
# prepare a list of 4 sub-dataframes, each corresponding to one classification
df_list <- split(df, df$classification)
```
```{r create-markdown-chunks-dynamically, include=FALSE}
out = NULL
for (c in names(df_list)) {
knit_expanded <- paste0("\n\n## Classification: ", c, "##\n\n```{r results='asis', echo=FALSE}\n\ndatatable(df_list[['", c, "']])\n\n```")
out = c(out, knit_expanded)
}
```
<!--- knit those table chunk statements -->
`r paste(knit(text = out), collapse = '\n')`