Creating a tab after an action button has been triggered in shiny - r

I'm trying to generate a tab panel after a user has pressed an action button in a Rmarkdown document that's using Shiny.
Here's a minimal viable example of what I have so far (not producing the desired results):
---
title: "Test Doc"
output: html_document
runtime: shiny
---
```{r, echo = FALSE, results="hide", message=FALSE, warning=FALSE}
library(shiny)
library(rmarkdown)
```
```{r, echo = FALSE, cache=FALSE}
sidebarPanel(
actionButton("testButton", label="Test!",
icon=icon("search"))
)
```
```{r, echo = FALSE, cache=FALSE}
tab_test_1<-eventReactive(input$testButton, {
output$tab_test<-renderUI({
tabsetPanel(tabPanel("Plot"))
})
})
uiOutput("tab_test")
```

Try with
```{r, echo = FALSE, cache=FALSE}
output$tab_test<-renderUI({
req(input$testButton);
tabsetPanel(tabPanel("Plot"))
})
uiOutput("tab_test")
```

Related

flexdashboard tabset with tables

When I add a table by DT::datatable or KableExtra::kbl() in a column with {.tabset} the output is not rendered in flexdashboard.
Any idea how to get a proper result?
Example:
I want to have one column with tabs. This is working without adding a table in the output component like in the example below
---
title: "tabs working"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: scroll
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
Page
=================================
Column {.tabset}
---------------------------------
### Tab 1
```{r }
```
### Tab 2
```{r}
```
When I do the same with datatable objects it is not rendered properly.
---
title: "tabs not working"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: scroll
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r load packages, echo=FALSE, include=FALSE}
library(DT)
```
Page
=================================
Column {.tabset}
---------------------------------
### Tab 1
```{r }
datatable(data.frame(seq(5, 3)))
```
### Tab 2
```{r}
datatable(data.frame(seq(5, 3)))
```
Then the output is like this
If you add a second column it will render.
---
title: "tabs not working"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: scroll
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r load packages, echo=FALSE, include=FALSE}
library(flexdashboard)
library(DT)
library(tidyverse)
```
Page
=================================
Column {.tabset}
---------------------------------
### Tab 1
```{r }
datatable(data.frame(seq(5,3)),
fillContainer = FALSE)
```
### Tab 2
```{r}
datatable(data.frame(seq(5,3)),
fillContainer = FALSE)
```
Column
---------------------------------
### Column 1
```{r, echo = FALSE}
ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width)) +
geom_point()
```
In the alternative, if you only want one column that includes the tabset, it's the equivalent of a single row. If you switch the layout to rows, it will render on its own. If you want to add columns further down the flexdashboard, you can just specify Column in the second block below.
---
title: "Untitled"
output:
flexdashboard::flex_dashboard:
orientation: rows
---
```{r setup, include=FALSE}
library(flexdashboard)
library(DT)
library(tidyverse)
```
Page
=================================
Row {.tabset}
---------------------------------
### Tab 1
```{r }
iris %>%
datatable()
```
### Tab 2
```{r}
mtcars %>%
datatable()
```
Column
---------------------------------
### Column 1
```{r, echo = FALSE}
ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width)) +
geom_point()
```
### Column 2
```{r, echo = FALSE}
ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width)) +
geom_point()
```

Creating and showing vector in a reactive environtment in Shiny

I having a problem using the shiny reactive environment. My problem is that the vector is not being completed. Everytime I presss the buttom the output goes to the row bellow, but erase the previous elemnt.
This is my code:
---
title: "teste"
author: "Teste1"
date: "03/01/2022"
output: html_document
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r}
actionButton("action1", "Press Button")
```
```{r, echo= FALSE, message = FALSE}
reactive({
u <- input$action1
w<- u + 2651641684
x <- c()
x[input$action1] <- paste("Texto",format(Sys.time(), "%S"))
print(x)
})
```
Why when I print(x) the vector doesnt store the previous elements when I press the button?
Any help?
Does this give you what you want?
---
title: "teste"
author: "Teste1"
date: "03/01/2022"
output: html_document
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r}
actionButton("action1", "Press Button")
```
```{r, echo= FALSE, message = FALSE}
v <- reactiveValues(x=c(), u=0)
observeEvent(input$action1, {
v$u <- v$u + 1
w <- v$u + 2651641684
v$x[v$u] <- paste("Texto",format(Sys.time(), "%S"))
print(v$x)
})
```

Why does include_graphics not render include_graphics(pdf) images when knitting to bookdown::word_document2

When knitting to word_document2, when using knitr::include_graphics on a pdf shows "The picture can't be displayed." where the image should be. It does work for .png.
```{r pressure, fig.cap = "testing", echo=FALSE}
plot(pressure)
```
```{r, include = FALSE}
png("pressure.png")
plot(pressure)
dev.off()
```
```{r, include = FALSE}
pdf("pressure.pdf")
plot(pressure)
dev.off()
```
```{r pressure-png, fig.cap = "testing png", echo = FALSE}
knitr::include_graphics("pressure.png")
```
```{r pressure-pdf, fig.cap = "testing pdf", echo = FALSE}
knitr::include_graphics("pressure.pdf")
```

Create static report from dynamic shiny markdown

I have a shiny markdown app in which I have several figures, say for different days of the week. Above these figures is a text area where I write some comments.
I want to be able to export this report to a static markdown format.
I'm presenting a (mainly) reproducible example below, the first part is the code that I would like to have edited so that it creates the code from the second part in a separate file.
---
title: "WEEKLY REPORT"
runtime: shiny
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = F)
```
```{r header, echo=FALSE}
selectInput("x", label = "x",choices = 1:10,width="100%")
actionButton("button", "Export report")
```
## Monday
```{r monday}
textAreaInput("mon", label = NULL)
renderPlot({
plot(log(1:input$x))
})
```
## Tuesday
```{r tuesday}
textAreaInput("tue", label = NULL)
renderPlot({
plot(sin(1:input$x))
})
```
How can I edit it so the action button creates a new a Rmd file containing the code below (or an Rmd file that would create a similar output)? (change png urls to any existing file to make it reproducible).
---
# title: "WEEKLY REPORT"
output: html_document
---
## Monday
The text I would have put on the first box
![](plot_monday.png)
## Tuesday
The text I would have put on the second box
![](plot_tuesday.png)
So basically the input selectors have to go, the text areas need to be changed to standard text (possibly containing markdown), and the plots have to be exported as picture files for the relevant inputs and then inserted back as pictures in the report.
Ideally I would also like to be able to export monday and tuesday into different Rmd files.
I think the easiest is to use a report template and pass in the inputs as parameters.
So, you create a new report with the filename "sampleRmdReport.Rmd" in the same directory as your Shiny report with the following contents:
---
title: "Weekly Report"
author: "Moody_Mudskipper"
date: '`r format(Sys.Date(),"%Y-%B-%d")`'
output: html_document
params:
mondayText: "holder"
tuesdayText: "holder"
x: "holder"
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, results = "asis")
```
# Monday
```{r}
cat(params$mondayText)
```
```{r}
plot(log(1:params$x))
```
# Tuesday
```{r}
cat(params$tuesdayText)
```
```{r}
plot(sin(1:params$x))
```
Then, add the following to your Shiny report:
Download the weekly report:
```{r}
downloadHandler(
filename = function(){
paste0("weeklyReport_generated_"
, format(Sys.Date(), "%Y%b%d")
, ".html")
}
, content = function(file){
rmarkdown::render(input = "sampleRmdReport.Rmd"
, output_file = file
, params = list(mondayText = input$mon
, tuesdayText = input$tue
, x = input$x
))
}
, contentType = "text/html"
)
```
making the full file:
---
title: "WEEKLY REPORT"
runtime: shiny
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = F)
```
```{r header}
selectInput("x", label = "x",choices = 1:10,width="100%")
```
Download the weekly report:
```{r}
downloadHandler(
filename = function(){
paste0("weeklyReport_generated_"
, format(Sys.Date(), "%Y%b%d")
, ".html")
}
, content = function(file){
rmarkdown::render(input = "sampleRmdReport.Rmd"
, output_file = file
, params = list(mondayText = input$mon
, tuesdayText = input$tue
, x = input$x
))
}
, contentType = "text/html"
)
```
## Monday
```{r monday}
textAreaInput("mon", label = NULL)
renderPlot({
plot(log(1:input$x))
})
```
## Tuesday
```{r tuesday}
textAreaInput("tue", label = NULL)
renderPlot({
plot(sin(1:input$x))
})
```
Then, clicking on the "Download" button will generate the report and prompt the user to download it. Note that if you test in RStudio, the file name won't work. I suggest opening it in the browser to test that.
Then, if you want to be able to generate separate daily reports, just add a template for the report you want and a download button for each. Or, you can make your downloadHandler generate a report for each day (from templates) and put them in a zipped directory to download together.
(Note: I tend to find this is more flexible in a Shiny App than in a markdown document, particularly as that allows more control of the download button. Depending on your use case, it may be worth considering that as an approach.)
Based on the comments, here is a version that would upload to Imgur and insert the images that way. Replace the other template with this or add a second button. Note that I did not make the imgur upload function work because I do not have an API key (I assume you do, since you are planning to do it this way).
---
title: "Weekly Report"
author: "Moody_Mudskipper"
date: '`r format(Sys.Date(),"%Y-%B-%d")`'
output:
html_document:
self_contained: false
params:
mondayText: "holder"
tuesdayText: "holder"
x: 1
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, results = "asis")
library(ggplot2)
tempDir <- tempdir()
uploadImgur <- function(fileName){
# This function would need to upload with the Imgur API
# I don't have a key, and don't want to set one up
# for this example.
# It would return the url that imgur assigns the image
# here, I am using a placeholder
outUrl <- "https://i.imgur.com/WsUV4DK.gif"
return(outUrl)
}
```
# Monday
```{r}
cat(params$mondayText)
```
```{r}
tempPlot <-
ggplot(mapping = aes(x = 1:params$x
, y = log(1:params$x))) +
geom_point() +
xlab("X") +
ylab("Y")
tempFile <- tempfile("plot_", tempDir, ".png")
ggsave(tempFile, tempPlot, width = 4, height = 4)
imgurURL <- uploadImgur(tempFile)
cat("![](", imgurURL,")", sep = "")
```
# Tuesday
```{r}
cat(params$tuesdayText)
```
```{r}
tempPlot <-
ggplot(mapping = aes(x = sin(1:params$x)
, y = log(1:params$x))) +
geom_point() +
xlab("X") +
ylab("Y")
tempFile <- tempfile("plot_", tempDir, ".png")
ggsave(tempFile, tempPlot, width = 4, height = 4)
imgurURL <- uploadImgur(tempFile)
cat("![](", imgurURL,")", sep = "")
```
If you are ok with using ggplot you can use ggsave to save the plots locally as png.
You could try this for your main file:
---
title: "WEEKLY REPORT"
runtime: shiny
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = F)
library(ggplot2)
```
```{r header, echo=FALSE}
selectInput("x", label = "x",choices = 1:10,width="100%")
actionButton("button", "Export report")
observeEvent(input$button,{
params <- list(text = input$mon)
render('report.Rmd',params = params)
})
```
## Monday
```{r monday}
textAreaInput("mon", label = NULL)
renderPlot({
p <- ggplot(data.frame(x=1:input$x,y=log(1:input$x)),aes(x=x,y=y))+
geom_point()
ggsave("plot.png",plot=p)
p
})
```
And for your static report (needs to be in the same folder as the other .Rmd):
---
# title: "WEEKLY REPORT"
output: html_document
---
## Monday
```{r}
params$text
```
![plot](plot.png)
I'm not sure how to make a proper download button with a download handler in a shiny Rmd so this only works when run from RStudio and not in a browser.

How to display image inside column with DT in R Markdown or shiny?

---
title: "Untitled"
runtime: shiny
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r}
df <- data.frame(image = "http://www.ufotm.com/data/attachment/forum/201203/11/110705gf50r55yqcka5ffz.jpg", title = "here is a title")
DT::renderDataTable(df,
escape = FALSE,
rownames = FALSE,
extensions = 'Buttons', options = list(
dom = 'lBfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print')
)
)
```
I have the image url. I try to insert image in a rmarkdown or shiny app. I prefer DT library because I can download excel file then. How can I do that?
PS: I want to provide excel or pdf file for my user to download as well.
I try to use DataTables Options, and find a related question. I tried the below code and it shows error.
---
title: "Untitled"
runtime: shiny
output: html_document
---
df <- data.frame(image = "http://www.ufotm.com/data/attachment/forum/201203/11/110705gf50r55yqcka5ffz.jpg", title = "here is a title")
DT::renderDataTable(df,
escape = FALSE,
rownames = FALSE,
extensions = 'Buttons', options = list(
dom = 'lBfrtip',
buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
columnDefs = list(list(targets = 1,
data = "img",
render = JS(
'function ( url, type, full) {',
'return '<img height="75%" width="75%" src="'+full[7]+'"/>';',
'}'
)
))
)
)
You can use html tags and use escape = FALSE as below:
---
title: "Untitled"
runtime: shiny
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r}
df <- data.frame(image = c('<img src="http://www.ufotm.com/data/attachment/forum/201203/11/110705gf50r55yqcka5ffz.jpg" height="52"></img>' ), title = "here is a title")
DT::renderDataTable(df, escape = FALSE)
```
You will get something like this:

Resources