I'm trying to trigger a popup message for a valueBox in flexdashboard using shinyjs. There's a similar question here but it doesn't work with flexdashboard.
The flexdashboard is created using an RMarkdown file.
---
title: "Test valuebox"
output:
flexdashboard::flex_dashboard:
orientation: rows
runtime: shiny
---
```{r}
library(flexdashboard)
library(shiny)
library(shinyjs)
useShinyjs(rmd = TRUE)
onclick('valbox', showModal(modalDialog(
title = "message",
"This is an important message!"
)))
```
Inputs {.sidebar}
-------------------------------------
```{r ui}
sliderInput('valsel', 'Select number:', min = 0, max = 10, value = 5)
```
Column
-------------------------------------
###
```{r}
output$valbox <- renderValueBox(flexdashboard::valueBox(input$valsel, "selected"))
valueBoxOutput('valbox')
```
I've inspected the HTML created by the app and the id for the value box is indeed 'valbox'. I tried creating a unique id with tags, but that didn't work either.
Related
I'm new to R/Shiny and I'm trying to build a dashboard that needs to render specific RMD scripts depending on which 'indicator' radio button is selected.
The aim is to have a fluidpage where an indicator is selected using radio buttons, which renders the associated chart.rmd to present the chart. I can render a specific chart.rmd manually but I encounter an issue when trying to get it reactive to the 'indicator' selection.
I have an excel lookup that contains a list of indicators and the names of the RMD files I want to render when the indicator is selected.
I'm using a reactive element that uses the indicator input to filter the lookup file and print out the name of the RMD I want to render.
Below is my code for the main dashboard RMD and the chart RMDs.
Main Dashboard RMD
---
output:
html_document:
runtime: shiny
---
```{r mainlibrary, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
# Load packages
library(shinythemes)
library(shinyWidgets)
library(shiny)
library(shinydashboard)
library(readxl)
library(dplyr)
library(shinyjs)
library(knitr)
library(withr)
library(rmarkdown)
# Function to render in RMD scripts
render_child <- function(path) {
withr::local_options(list(htmltools.preserve.raw = FALSE))
markdown(knitr::knit_child(path, quiet = TRUE,envir = knit_global()))
}
```
```{r data, include=FALSE}
# Read in chart lookup table
lookup <- read_xlsx("Lookup.xlsx")
```
```{r code, echo=FALSE}
Chart_output <- reactive({
req(input$Indicator_choice)
Chart_output <-lookup %>%
filter(Indicator == input$Indicator_choice)
Chart_output <- as.character(Chart_output[2])
#renderUI(Chart_output)
})
Chart_output
```
```{r Page, echo=FALSE}
fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons(
inputId = "Indicator_choice",
label = "Select indicator",
choices = unique(lookup$Indicator),
selected = "One"
)
),
mainPanel(
HTML(render_child({Chart_output()}))
#renderText({Chart_output()}),
)
)
# End of fluidpage
)
```
Chart 1 RMD
---
title: "Chart 1"
output:
html_document:
runtime: shiny
---
```{r chart1_test, echo=FALSE}
print("Chart 1 RMD")
```
Chart 2 RMD
---
title: "Chart 2"
output:
html_document:
runtime: shiny
---
```{r chart2_test, echo=FALSE}
print("Chart 2 RMD")
```
Chart 3 RMD
---
title: "Chart 3"
output:
html_document:
runtime: shiny
---
```{r chart3_test, echo=FALSE}
print("Chart 3 RMD")
```
When I try running the dashboard I get this error:
*Error: Operation not allowed without an active reactive context.
You tried to do something that can only be done from within a reactive consumer.
The closest I’ve got is printing out the name of the RMD I want to render using a reactive element, but I am unable to use that in the main panel of the fluidpage to render the RMD.
I've managed to get the dashboard working by using a different method that renders each chart into its own object. I can then use render UI to load specific chart RMDs depending on what indicator is selected. Although this method works, I'm concerned the loading time will be too long as the final dashboard will contain 30 chart RMDs that will need to be read in at the beginning of the script.
Working Main Dashboard RMD
---
output: html_document
runtime: shiny
---
```{r mainlibrary, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
# Load packages
library(shinythemes)
library(shinyWidgets)
library(shiny)
library(shinydashboard)
library(readxl)
library(dplyr)
library(shinyjs)
library(knitr)
library(withr)
# Function to render in RMD scripts
render_child <- function(path) {
withr::local_options(list(htmltools.preserve.raw = FALSE))
markdown(knitr::knit_child(path, quiet = TRUE,envir = knit_global()))
}
```
```{r, echo = FALSE}
# Store the rendered files as
Chart_1 <- HTML(render_child("Chart_Rmd_1.Rmd"))
Chart_2 <- HTML(render_child("Chart_Rmd_2.Rmd"))
Chart_3 <- HTML(render_child("Chart_Rmd_3.Rmd"))
fluidPage(
radioButtons(
inputId = "Indicator_choice",
label = "Select indicator",
# choices = unique(lookup$Indicator),
choices = c("One", "Two", "Three"),
selected = "One"
),
uiOutput("test_output")
)
output$test_output <- renderUI({
req(input$Indicator_choice)
switch(input$Indicator_choice,
"One" = Chart_1,
"Two" = Chart_2,
"Three" = Chart_3)
})
```
Ideally, I would to use the first method but I'm not sure how to solve the issue or know if it's even possible. Any advice would be appreciated.
How can I determine if the user is looking at a particular page in a flexdashboard? I have a global sidebar panel of filters that applies to all pages except one of the filters in the sidebar doesn't apply to one of the pages. In this example, let's say I don't want the selectInput() to be displayed on Page 3.
---
title: "Which Page?"
runtime: shiny
output: flexdashboard::flex_dashboard
---
Sidebar {.sidebar data-width=400}
=====================================
```{r}
textInput("text", NULL)
selectInput("select", NULL, LETTERS[1:5])
```
Page 1
=====================================
Page 2
=====================================
Page 3
=====================================
I was hoping to use session$clientData$url_hash but this is static and based on the page the user initially opened. You can put this in the sidebar section to see how it (doesn't) change. Other ideas I've found are to use window.location or is.visible in js but not sure how to integrate.
print_info <- function(x) {
allvalues <-
lapply(
X = sort(names(x)),
FUN = function(name) {
item <- x[[name]]
paste(name, item, sep = " = ")
}
)
paste(allvalues, collapse = "\n")
}
output$client_data <- renderText(print_info(session$clientData))
verbatimTextOutput("client_data")
Solution 1 : "pure Shiny"
You can take advantage of the fact that renderXXX() is only calculated on active page. For example here we can use renderUI() on each page to update a reactive value tab with the current page number. That value is then used in the side bar to check if the selectInput will be displayed with the renderUI :
---
title: "Which Page?"
runtime: shiny
output: flexdashboard::flex_dashboard
---
Sidebar {.sidebar data-width=400}
=====================================
```{r}
textInput("text", NULL)
tab <- reactiveVal(1)
renderUI({
if(tab()!=3)
selectInput("select", NULL, LETTERS[1:5])
})
```
Page 1
=====================================
```{r}
renderUI({tab();tab(1);NULL})
```
Page 2
=====================================
```{r}
renderUI({tab();tab(2);NULL})
```
Page 3
=====================================
```{r}
renderUI({tab();tab(3);NULL})
```
Solution 2 : with JavaScript
You can also use a JS event
(note the use of is.null() as event is not triggered on page 1 initial display):
---
title: "Which Page?"
runtime: shiny
output: flexdashboard::flex_dashboard
---
<script>
$("body").on("shown.bs.tab", "a[data-toggle='tab']", function(e) {
Shiny.setInputValue("active_tab", $(e.target).parent().index() + 1);
})
</script>
Sidebar {.sidebar data-width=400}
=====================================
```{r}
textInput("text", NULL)
renderUI({
if(is.null(input$active_tab) || input$active_tab!=3)
selectInput("select", NULL, LETTERS[1:5])
})
```
Page 1
=====================================
Page 2
=====================================
Page 3
=====================================
below is my reprex. Post clicking the upload button, the text appears. Upon clicking the clear button the text should go off. Wanted to check the way to do this. Can anyone help me here
---
title: "Untitled"
runtime : shiny
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
---
```{r setup, include=FALSE}
library(flexdashboard)
code <- "This is code"
```
Column {data-width=650}
-----------------------------------------------------------------------
### Chart A
```{r}
actionButton("upload","Upload",width = 150)
actionButton("clear_upload","Clear",width = 150)
verbatimTextOutput("code")
get_code <- eventReactive(input$upload,{
code
})
output$code <- renderPrint(
get_code()
)
```
If I've correctly understood your problem, you may use the the observeEvent statement:
---
title: "Untitled"
runtime : shiny
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
---
```{r setup, include=FALSE}
library(flexdashboard)
code <- "This is code"
```
Column {data-width=650}
-----------------------------------------------------------------------
### Chart A
```{r}
actionButton("upload","Upload",width = 150)
actionButton("clear_upload","Clear",width = 150)
verbatimTextOutput("code")
get_code <- eventReactive(input$upload,{
code
})
observeEvent(input$upload, {output$code <- renderPrint(get_code())})
observeEvent(input$clear_upload, {output$code <- renderPrint("")})
```
I have the basic flexdashboard below. What I want is to change line after "hello" in order to place "world" below it,inside the renderText(). I have found that I can use htmlOutput() and verbatimTextOutput() but these are not used in flexdashboard.
---
title: "[School Name] Enrollment Projections for Fall 2019"
output:
flexdashboard::flex_dashboard:
orientation: rows
runtime: shiny
---
```{r setup, include = FALSE}
library(flexdashboard)
library(shiny)
```
Column {.sidebar }
-------------------------------------
### Menu
```{r}
renderText({
paste("hello", "world", sep="\n")
})
```
Row {data-height=400}
-------------------------------------
### Enrollments
```{r}
```
I am trying to contiditonally do either one type of render (renderPlot) or another (renderText) based on some input. Here's what I tried:
---
title: "Citation Extraction"
output:
flexdashboard::flex_dashboard:
vertical_layout: scroll
orientation: rows
social: menu
source_code: embed
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(shiny)
```
Sidebar {.sidebar}
=====================================
```{r}
textInput("txt", "What's up?:")
```
Page 1
=====================================
### Chart A
```{r}
urtxt <- reactive({input$txt})
if (nchar(urtxt()) > 20){
renderPlot({plot(1:10, 1:10)})
} else {
renderPrint({
urtxt()
})
}
```
But it states:
So I tried adding a reactive around the conditional resulting in returning the function reactive returns.
reactive({
if (nchar(urtxt()) > 20){
renderPlot({plot(1:10, 1:10)})
} else {
renderPrint({
urtxt()
})
}
})
How can I have conditional reactive logic?
To get different kind of output depending on the length of the inputed character string you can do following:
1) Create a dynamic output uiOutput,
2) In the reactive environment renderUI, depending on the input, choose kind of the output.
3) Render the output
---
title: "Citation Extraction"
output:
flexdashboard::flex_dashboard:
vertical_layout: scroll
orientation: rows
social: menu
source_code: embed
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(shiny)
```
Sidebar {.sidebar}
=====================================
```{r, echo = F}
textInput("txt", "What's up?:", value = "")
```
Page 1
=====================================
### Chart A
```{r, echo = F}
uiOutput("dynamic")
output$dynamic <- renderUI({
if (nchar(input$txt) > 20) plotOutput("plot")
else textOutput("text")
})
output$plot <- renderPlot({ plot(1:10, 1:10) })
output$text <- renderText({ input$txt })
```