I'm trying to incorporate an Rmd I have been using into a flexdashboard. I'm curious if it is possible to isolate an uploaded file and use it as-is rather than writing a bunch of reactive functions. If this is my template, is it possible to get a static object named df that the child document can go ahead and run with?
---
title: "help"
runtime: shiny
output:
flexdashboard::flex_dashboard:
orientation: columns
---
```{r}
fileInput("data", "select data")
df <- isolate(input$data)
```
```{r, child="some_code.Rmd"}
```
My real example does something completely different but let's say some_code.Rmd looks like this:
---
title: "some code"
output: html_document
---
```{r packages, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE)
library(tidyverse)
```
The data looks like this:
```{r}
as_tibble(df)
```
The numeric data can be summarized with the following means
```{r}
df |>
summarise(across(where(is.numeric), mean)) |>
gather()
```
This ended up working:
knitr::knit() + markdown::markdownToHTML() + HTML() ---> renderUI()
---
title: "help"
runtime: shiny
output:
flexdashboard::flex_dashboard:
orientation: rows
---
Sidebar {.sidebar}
==============================================
```{r file-input}
fileInput("data", "select data")
```
Row
==============================================
```{r knit-child}
observeEvent(input$data, {
df <- isolate(read.csv(input$data$datapath))
new_env <- list2env(list(df = df))
output$res <- renderUI({
knitr::knit("some_code.Rmd", quiet = TRUE, envir = new_env) |>
markdown::markdownToHTML() |>
HTML()
})
})
uiOutput("res")
```
Related
I'd like to create a pdf report for each cylinder ('cyl') between the 3 possibilities (4, 6 and 8) in a separate table. But, I need to create one table for each cylinder in a loop and for this I try to do:
library(knitr)
library (rmarkdown)
data(mtcars)
id.cyl <-unique(mtcars$cyl)
for(i in 1:id.cyl){
mtcars.sub<-
mtcars[mtcars$cyl==id.mtcars[i],]
kagle(mtcars.sub)
}
render("my_loop_report.pdf",
pdf_document())
This code doesn't work and I need some suggestions to solve it. Please any help with it?
Create an .rmd file that generates the report, and pass the cylinder as a value.
Here is the .rmd file (say, cylinder.rmd)
---
title: "cylinder_report"
author: "author_name"
date: "2023-01-25"
output: pdf_document
params:
cylinder: 0
---
``{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
df = mtcars
``
## Cylinder `r params$cylinder`
``{r output, echo=FALSE}
knitr::kable(df[df$cyl == params$cylinder,])
``
Separately, you can then loop through the cylinder values, each time passing the cylinder value
cyls = unique(mtcars$cyl)
for(cyl in cyls) {
rmarkdown::render(
input = "cylinder.Rmd",
output_file = paste0("cylinder_report_", cyl),
params = list(cylinder = cyl)
)
}
This will produce cylinder_report_4.pdf, cylinder_report_6.pdf, and cylinder_report_8.pdf.
(Note, in this toy example, you don't even have to pass the parameter; in fact, loading mtcars into df and subsetting it within the .rmd is not necessary. When you use `rmarkdown::render(), objects in the environment are available to the .rmd file, so you could also subset the data in the loop outside the rmd file, like this,
cyls = unique(mtcars$cyl)
for(cyl in cyls) {
df = mtcars[mtcars$cyl == cyl,]
rmarkdown::render(
input = "cylinder.Rmd",
output_file = paste0("cylinder_report_", cyl)
)
}
and the .rmd could be simplifed to this (note, no parameter, no creation of df, no subsetting, etc:
---
title: "cylinder_report"
author: "author_name"
date: "2023-01-25"
output: pdf_document
---
``{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
``
## Cylinder `r cyl`
``{r output, echo=FALSE}
knitr::kable(df)
``
)
I have a list of many (can be dozens of) tables created with the gt package in R. I would like to export them all as a single HTML file with a little space between each table. Currently, I have been exporting each table individually, reading them into an RMarkdown with the xfun package, and knitting to a single HTML file. I'm curious if there is a method to cut out the intermediate step of saving each table individually and reading into the Rmd.
Example:
library(gt)
library(tidyverse)
tbl_list <- list(mtcar_tbl = mtcars %>% gt(),
iris_tbl = iris %>% gt(),
cars_tbl = cars %>% gt())
purrr::map(seq_along(tbl_list), function(rownum){
htmltools::save_html(html = tbl_list[[rownum]],
file = paste0("test",rownum,".html"))
})
RMarkdown to combine and export tables:
---
title: ""
output: html_document
---
```{r, echo=FALSE,message=FALSE,warning=FALSE}
library(xfun)
```
```{r echo=FALSE}
htmltools::includeHTML("test1.html")
```
<br><br>
```{r echo=FALSE}
htmltools::includeHTML("test2.html")
```
<br><br>
```{r echo=FALSE}
htmltools::includeHTML("test3.html")
```
One option would be to use purrr::walk with chunk option results="asis" to directly print your tables without the intermediate step. To add the line breaks after each table use cat("<br><br>"):
Note: For the reprex I just print the head of each table.
---
title: "Untitled"
output: html_document
date: "2022-09-19"
---
```{r echo=FALSE, results='asis', warning=FALSE, message=FALSE}
library(gt)
library(tidyverse)
tbl_list <- list(mtcar_tbl = mtcars,
iris_tbl = iris,
cars_tbl = cars)
tbl_list <- purrr::map(tbl_list, ~ head(.x) %>% gt() )
purrr::walk(tbl_list, function(x) { print(x); cat("<br><br>") })
```
I often want to print out the dataframes contained in a list as paged tables in my rmarkdown documents. Calling each dataframe individually renders the desired ouptut if the right df_print option is selected. However, the point of having a list is that the number of dataframes varies depending on the parameters passed to the rmarkdown document; so that's no real solution.
Based on Vincent Guyader's answer to this question and on this example of rmarkdown::paged_table, I've tried to do the following without success.
Is there a way to achieve this at all? I'd be happy to use any package that supports pagination remotely resembling the df_print option.
---
title: "Printing paged tables from a list of dataframes in Rmarkdown"
output:
html_document:
df_print: paged
---
```{r}
library(DT)
library(rmarkdown)
library(purrr)
library(knitr)
df_list <- list("cars" = mtcars, "flowers" = iris)
knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE, results='asis')
```
### Desired output but impossible to generalise
```{r}
df_list[["cars"]]
```
```{r}
df_list[["flowers"]]
```
### datatable shows as blanks on the page
```{r}
map(df_list, ~DT::datatable(.x) %>%
htmltools::tagList() %>%
print())
```
### rmarkdown outputs dataframe contents as one very long string
```{r}
map(df_list, rmarkdown::paged_table)
```
The issue is that the JS dependencies needed to render the Datatable are not included in the HTML output. A workaround which I borrowed from here is to add a code chunk
```{r init-step, include=FALSE}
DT::datatable(mtcars)
```
outside of the loop or map statement which ensures that the JS dependencies are included. Also, I would recommend to switch to purrr::walk as using map has the effect that the tables are plotted twice.
---
title: "Printing paged tables from a list of dataframes in Rmarkdown"
output:
html_document:
df_print: paged
---
```{r}
library(DT)
library(rmarkdown)
library(purrr)
library(knitr)
df_list <- list("cars" = mtcars, "flowers" = iris)
knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE, results='asis')
```
### Desired output but impossible to generalise
```{r}
df_list[["cars"]]
```
```{r}
df_list[["flowers"]]
```
### datatable shows as blanks on the page
```{r init-step, include=FALSE}
DT::datatable(mtcars)
```
```{r}
walk(df_list, ~DT::datatable(.x) %>%
htmltools::tagList() %>%
print())
```
When using results='asis' argument, the renderer (here DT) has to be initialized once before being applied on a asis list.
This seems to be a general problem, see here with leaflet, and here with Highcharter.
The answer to this general question has been given here.
In this case:
---
title: "Printing paged tables from a list of dataframes in Rmarkdown"
output:
html_document:
df_print: paged
---
```{r,}
library(DT)
library(rmarkdown)
library(purrr)
library(knitr)
df_list <- list("cars" = mtcars, "flowers" = iris)
knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE, results='asis')
# initialize the renderer
data.frame() %>%
DT::datatable() %>%
knitr::knit_print() %>%
attr('knit_meta') %>%
knitr::knit_meta_add() %>%
invisible()
```
```{r , results='asis'}
#Remove already printed element and print the rest
df_list[[1]] <- NULL
map(df_list, ~DT::datatable(.x) %>%
htmltools::tagList() %>%
print())
```
I have a parent-child Rmarkdown file and I am trying to embed a Shiny UI-server structured DT table in the child rmd file. But the DT item won't render in child(but if put in parent, it will). When inspecting the HTML output, error message in dom saying:
shinyapp.js:342 Uncaught Duplicate binding for ID table_diamond
favicon.ico:1 Failed to load resource: the server responded with a status of
404 (Not Found)
Below is the sampled code I have:
Parent.Rmd:
---
title: "Hello Prerendered Shiny"
output:
html_document:
fig_caption: yes
keep_md: no
number_sections: no
theme: cerulean
toc: yes
toc_depth: 5
toc_float:
collapsed: true
runtime: shiny_prerendered
---
```{r setup, results=FALSE, eval=TRUE, echo=FALSE, message=FALSE, warning=FALSE}
library(DT)
library(tidyverse)
library(knitr)
library(c3)
```
## Content Listed by diamond color
```{r echo=FALSE, eval=TRUE, include=FALSE, warning=FALSE}
color <- levels(diamonds$color)
out <- NULL
for (c in color){
colorNum <- 0
for (ct in 1: length(levels(diamonds[diamonds$color== c, ]$cut ))) {
this_cut <- levels(diamonds[diamonds$color==c, ]$cut)[ct]
env = new.env()
out <- c(out, knit_child('sample_child.Rmd', envir = env))
colorNum <- colorNum +1
}
}
```
`r paste(out, collapse='\n')`
Child Rmd:
---
output: html_document
runtime: shiny_prerendered
---
```{r eval='TRUE', echo=FALSE, results='asis'}
if(colorNum ==0) cat('\n##',c,'\n'); #cat('\n');
```
### `r this_cut`
#### Price range on fixed color and cut
```{r eval=TRUE, echo=FALSE, fig.retina=1, dpi = 72,results='asis', warning=FALSE}
data <-subset(diamonds, color == c) %>%
filter(cut == this_cut) %>%
as.data.frame()
plot(x = data$clarity, y = data$price, ylab = 'Price', xlab = 'clarity')
```
#### Detail Table
```{r, echo=FALSE}
DT::dataTableOutput("table_diamond")
submitButton("Save")
```
```{r, context="server"}
output$table_diamond <- DT::renderDataTable({
data <-subset(diamonds, color == c) %>%
filter(cut == this_cut) %>%
as.data.frame()
datatable(data)
})
```
Any insights?
Figured out why:
Just as dom error said “shinyapp.js:342 Uncaught Duplicate binding for ID table_diamond”,the loop is creating output dataTable using the same output ID "table_diamond".
To make this output Id dynamic, in UI:
table_id <- paste0('table_', c, this_cut)
dataTableOuput(outputId = table_id)
in Server, use double square brackets [[ ]] instead of $:
output[[table_id]] <- DT::renderDataTable({
data <-subset(diamonds, color == c) %>%
filter(cut == this_cut) %>%
as.data.frame()
datatable(data)
})
Thanks to R Shiny dynamic tab number and input generation
I have a problem with a RMD script. It runs. Once. After that, I get partial results.
The code:
---
title: "Dashboard"
output:
flexdashboard::flex_dashboard:
runtime: shiny
---
```{r global, include=FALSE}
library(dplyr)
library(flexdashboard)
Name=c('Test1', 'Test1', 'Test2')
Number = c(8, 9, 7)
zt <- data.frame(Name, Number)
PersonList <- sort(unique(zt$Name))
```
Selections {.sidebar}
===============================
```{r}
## The shiny part
selectInput("PersonSel", "Person: ", PersonList, selected = 'Test1')
```
Tab 1
======================================================================
Row {.tabset}
-----------------------------------------------------------------------
### Table
```{r}
renderTable({
cqi <- zt %>%
na.omit() %>%
filter(Name %in% input$PersonSel) %>%
group_by(Number) %>%
summarise(Count = n())
}, align='l')
```
Result:
When I run the script again, I get this:
In R Studio I see this:
But only this - it doesn't continue.
The only way to get it working again is to edit the script. Add a space or whatever.
Is seems very strange behavior. What can be the problem (and solution) here?