gtExtras winloss table in loop rendering with partially raw, partially rendered HTML - r

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

Related

Table rendering in pdf document using R markdown

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

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

R Markdown does not create .pdf and .doc ( with package flextable) is not able to knit accordingly

I am trying to create .pdf and .doc to generate report from the following code. there are two problems in total:
with .pdf output
R is working out but once i knit with pdf then it run whole code and generate .pdf file with 0 kb. I am not able to open this file.
.doc output
In .doc file i want to change layout of pages and want to use pagebreak but its not working out.
I also want to write code for page layout(landscape or portrait), but its not working. As i can only create the portrait page but table which i created with flextable is not autofitting in page.
I installed MIKTEX but then table and graph is floating in documents. so i uninstalled it.
I dont understand what is "cairo out of memory" in error.
---
title: "Bla bla bla"
author: "Kishan"
date: "`r format(Sys.time(), '%d.%m.%Y')`"
output:
pdf_document: default
word_document: default
html_document: default
---
# Global option --------
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, messAgegr = FALSE,
comment=FALSE, warning=FALSE,
results = "asis", dpi=600,
fig.width= 15, fig.height=8 ,
dev = "cairo_pdf"
)
options(kableExtra.latex.load_packages=TRUE,
kableExtra.auto_format=FALSE)
library(tidyr)
library(dplyr)
library(janitor)
library(ggplot2)
library(readxl)
library(knitr)
library(kableExtra)
library(tinytex)
library(flextable)
options(tinytex.verbose = TRUE)
ggpt <- theme_bw() +
theme(#text=element_text(size=rel(1.7)),
axis.title.x=element_text(size=rel(1.5)),
axis.title.y=element_text(size=rel(1.5)),
axis.text.x=element_text(size=rel (1.5)),
axis.text.y=element_text(size=rel (1.5)),
strip.text.x=element_text(size=rel(1.2)),
strip.text.y=element_text(size=rel(1.2)),
legend.text=element_text(size=rel (1.3)),
legend.title=element_text(size=rel(1.3)),
plot.title=element_text(size=rel (1.5)))
doc_type <- knitr::opts_knit$get("rmarkdown.pandoc.to")
if(is.null(doc_type)) {
doc_type <- "raw"
}
```
```{r}
stdtabl <- function(data, caption=NULL, format="raw") {
if(format %in% c("latex", "html")) {
data %>%
knitr::kable(booktabs=TRUE,
format=format,
digits=0,
caption=caption) %>%
kable_styling(bootstrap_options=c("striped", "hover", "condensed", "responsive"),
full_width=FALSE,
font_size=12,
fixed_thead=TRUE,
position="center") %>%
column_spec(column=1,
bold=TRUE)
} else if(format == "docx") {
## use flextable as kableExtra does not handle Word documents
data %>%
flextable() %>%
theme_zebra() %>%
autofit() %>%
font(fontname="Calibri")
} else { "raw"
data %>%
knitr::kable()
}
}
```
```{r}
mobitab <- EQBase %>%
tabyl(Zeitpunkt, eq5d5lMobil) %>%
adorn_percentages("row") %>%
adorn_pct_formatting(digits = 0 ) %>%
adorn_ns(position = "front") %>%
select(Zeitpunkt,'mob_1','mob_2','mob_3','mob_4','mob_5','V1')
stdtabl(mobitab, caption= 'sdsdyfwerfew', format=doc_type)
```
```{r}
barplotmob <- EQBase %>%
mutate(eq5d5lMobil= factor(eq5d5lMobil, levels = c("","mob_5", "mob_4", "mob_3", "mob_2", "mob_1"))) %>%
group_by(VisitID, eq5d5lMobil) %>%
summarise(Count= n()) %>%
mutate(Percentage = Count/sum(Count)*100, round(Percentage, digits=0)) %>%
mutate(lab_ypos = 100-(cumsum(Percentage) - 0.5 * Percentage))
ggplot(barplotmob, aes(x=factor(VisitID), y=Percentage, fill = factor(eq5d5lMobil))) +
geom_bar(stat="identity", width = 0.7)+
geom_text (aes(y = lab_ypos, label = paste0(round(Percentage, digits=0)), group =eq5d5lMobil),
color = "black", size = 3)
```
>Quitting from lines 238-274 (EQ5D_1.rmd)
Fehler in (function (filename = if (onefile) "Rplots.pdf" else "Rplot%03d.pdf", :
unable to start device 'cairo_pdf'
Ruft auf: <Anonymous> ... in_base_dir -> in_dir -> plot2dev -> do.call -> <Anonymous>
Zusätzlich: Warnmeldungen:
1: Calling `as_tibble()` on a vector is discouraged, because the behavior is likely to change in the future. Use `enframe(name = NULL)` instead.
This warning is displayed once per session.
2: In (function (filename = if (onefile) "Rplots.pdf" else "Rplot%03d.pdf", :
cairo error 'out of memory'
Ausführung angehalten

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.

Why does datatable not print when looping in rmarkdown?

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')`

Resources