Creating and showing vector in a reactive environtment in Shiny - r

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

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

render plot doesn't appear

I am using the code below to render a plot but the plot doesn't appear.
---
title: "Untitled"
author: "George"
date: "12/3/2018"
output:
flexdashboard::flex_dashboard:
orientation: rows
runtime: shiny
---
```{r global, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
library(flexdashboard)
library(dplyr)
library(GGally)
x <- c(1,2,3)
y <- c(11,22,33)
z <- data.frame(x, y)
```
Introduction
=======================================================================
### General info
- A
- B
Corr
=======================================================================
### Correlation
```{r include=TRUE, results='hide'}
renderPlot({
GGally::ggpairs(z)
})
```
I'd remove what you have in the chunk options:
```{r}
renderPlot({
GGally::ggpairs(z)
})
```

R markdown with interactive option of the Chunk

I try to have a Markdown document with a verbose option (i.e. show or not the code of the page, to avoid to afraid people :D ) depending on the choice of the user (basically a radio button widget).
I therefore executed the following code:
---
title: "Hello"
author: "Charlotte S."
date: "8 février 2018"
output: html_document
runtime: shiny
---
```{r}
radioButtons("verbose", label = "",
choices = c("Yes", "No"),
selected = "No")
verboseAction <- reactive({
if(!is.null(input$verbose)){
if(input$verbose == "Yes"){
TRUE
} else {
FALSE
}
} else {
FALSE
}
})
output$print <- renderText({
verboseAction()
})
```
Here `r textOutput("print")`
```{r echo = verboseAction()}
2+2
```
the answer of R: "operation not allowed without a reactive context
Ok no problem, I did:
---
title: "Hello"
author: "Charlotte S."
date: "8 février 2018"
output: html_document
runtime: shiny
---
```{r}
radioButtons("verbose", label = "",
choices = c("Yes", "No"),
selected = "No")
verboseAction <- reactive({
if(!is.null(input$verbose)){
if(input$verbose == "Yes"){
TRUE
} else {
FALSE
}
} else {
FALSE
}
})
output$print <- renderText({
verboseAction()
})
```
Here `r textOutput("print")`
```{r echo = observe(verboseAction())}
2+2
```
not working neither
---
title: "Hello"
author: "Charlotte S."
date: "8 février 2018"
output: html_document
runtime: shiny
---
```{r}
radioButtons("verbose", label = "",
choices = c("Yes", "No"),
selected = "No")
verboseAction <- reactive({
if(!is.null(input$verbose)){
if(input$verbose == "Yes"){
TRUE
} else {
FALSE
}
} else {
FALSE
}
})
output$print <- renderText({
verboseAction()
})
```
Here `r textOutput("print")`
```{r global_options, include=FALSE}
option <- reactive({
if(!is.null(verboseAction())){
opts_chunk$set(fig.width=12, fig.height=8, fig.path='Figs/',
echo=verboseAction(), warning=FALSE, message=FALSE)
}
})
```
```{r}
2+2
```
Nope nope nope
Do you have an idea how to do that? I could not find any example with a reactive values in the {r}, I am not even sure its possible ... (I also tried with a tcltk but it's worse because no reactivity)...
Thanks in advance and have a good day !
Cha
Overview
You want to declare the code_folding option in your Yet Another Markup Language (YAML) header.
You can set the default code folding to automatically hide (code_folding: hide) or show (code_folding: show) the code chunks from the user.
---
title: "Hello"
author: "Charlotte S."
date: "8 février 2018"
output:
html_document:
code_folding: hide
runtime: shiny
---
```{r}
radioButtons("verbose", label = "",
choices = c("Yes", "No"),
selected = "No")
verboseAction <- reactive({
if(!is.null(input$verbose)){
if(input$verbose == "Yes"){
TRUE
} else {
FALSE
}
} else {
FALSE
}
})
output$print <- renderText({
verboseAction()
})
```
Here `r textOutput("print")`
```{r global_options, include=FALSE}
option <- reactive({
if(!is.null(verboseAction())){
opts_chunk$set(fig.width=12, fig.height=8, fig.path='Figs/',
echo=verboseAction(), warning=FALSE, message=FALSE)
}
})
```
```{r}
2+2
```

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.

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

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

Resources