Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Shiny modularized inputs inside pop-up modal aren't being written to reactiveValues when dismissed [flexdashboard/shinydashboard]

As a minimally-viable example, I modularized the basic example from here: https://rmarkdown.rstudio.com/flexdashboard/shiny.html#simple_example

Code snippet (copy-paste, run as .Rmd in RStudio should do the trick):

---
title: "stackoverflow example"
output: flexdashboard::flex_dashboard
runtime: shiny
---

```{r global, include=FALSE}
library(shiny)
library(flexdashboard)  # install.packages("flexdashboard")
# load data in 'global' chunk so it can be shared by all users of the dashboard
library(datasets)
data(faithful)

# UI modules
sidebarCharts <- function(id) {
  ns <- NS(id)
  tagList(
    p(),
    actionButton(ns("settings"), "Settings", icon = icon("cogs"), width = '100%', class = "btn btn-info"),p(),
    actionButton(ns("refreshMainChart") ,"Refresh", icon("refresh"), width = '100%', class = "btn btn-primary"),p()
    ,textOutput(ns("info"))  # FOR DEBUGGING
  )
}

mainChartUI <- function(id) {
  ns <- NS(id)
  plotOutput(ns("mainChart"), width = "100%")
}

# UI module for the 2 buttons in the modal:
modalFooterUI <- function(id) {
  ns <- NS(id)
  tagList(
    modalButton("Cancel", icon("remove")),
    actionButton(ns("modalApply"), "Apply", icon = icon("check"))
  )
}

server <- function(input, output, session) {

  # Init reactiveValues() to store values & debug info; https://github.com/rstudio/shiny/issues/1588
  rv <- reactiveValues(clicks = 0, applyClicks = 0,
                       bins = 20,
                       bandwidth = 1)

  # DEBUGGING
  output$info <- renderText({
    paste("You clicked the 'Settings' button", rv$clicks, "times. You clicked the 'Apply' button", rv$applyClicks, "times. The bin size is currently set to", rv$bins, "and the bandwidth is currently set to", rv$bandwidth)
  })

  settngsModal <- function(id) {
    ns <- NS(id)
    modalDialog(
      withTags({  # UI elements for the modal go in here
        fluidRow(
          column(4, "Inputs",
                 selectInput(ns("n_breaks"), label = "Number of bins:", choices = c(10, 20, 35, 50), selected = rv$bins, width = '100%')),
          column(4, "Go",
                 sliderInput(ns("bw_adjust"), label = "Bandwidth adjustment:", min = 0.2, max = 2, value = rv$bandwidth, step = 0.2, width = '100%')),
          column(4, "Here")
        )
      }),
    title = "Settings",
    footer = modalFooterUI("inputs"), 
    size = "l",
    easyClose = FALSE,
    fade = TRUE)
  }

  # Sidebar 'Settings' modal
  observeEvent(input$settings, {
    showModal(settngsModal("inputs"))  # This opens the modal; settngsModal() defined below
    rv$clicks <- rv$clicks + 1  # FOR DEBUGGING
  })

  observeEvent(input$modalApply, {
    rv$applyClicks <- rv$applyClicks + 1  # FOR DEBUGGING
    rv$bins <- input$n_breaks  # This is where I set the reactiveValues() to those inputted into the modal.
    rv$bandwith <- input$bw_adjust
    removeModal()  # This should dismiss the modal (but it doesn't seem to work)
  })

  output$mainChart <- renderPlot({
    input$refreshMainChart  # Take dependency on the 'Refresh' buton

    hist(faithful$eruptions, probability = TRUE, breaks = as.numeric(rv$bins),  
         xlab = "Duration (minutes)", main = "Geyser Eruption Duration")

    dens <- density(faithful$eruptions, adjust = rv$bandwidth)
    lines(dens, col = "blue")
  })

}

```

Column {.sidebar}
-----------------------------------------------------------------------

```{r}
callModule(server, "main")
sidebarCharts("main")
```

Column
-----------------------------------------------------------------------

### Main chart goes here

```{r}
mainChartUI("main")
```

Screenshots:

Launch Modal

This is the desired functionality:

  1. On app launch, the chart should render with default parameters for bin-size and bandwidth stored in rv which is a reactiveValues() -- this appears to work.
  2. When I click the modal, for the first time, it should appear with the default parameters for bin-size and bandwidth -- this also appears to work.
  3. When I update either of the input parameters AND click 'Apply', it should dismiss the modal and subsequently set the respective parameters inside the rv reactiveValues() object to the one(s) selected -- THIS DOES NOT WORK (neither modal is dismissing, nor are reactiveValues being updated).
  4. After the reactiveValues() inside rv are updated with the new ones, the chart should NOT re-render until user hits the 'Refresh' actionButton -- this also does not work, but is contingent on (3) above.

What am I doing wrong?? It feels like I'm overlooking something super simple.

Thanks!!

like image 708
Ray Avatar asked Aug 27 '18 15:08

Ray


1 Answers

The problem comes from the fact that your modal and your server function have different namespace id's and so can't talk to each other in a normal way.

When you call your server function with callModule, you give your module the namespace id of "main". When you generated your Modal, you gave it the namespace id of "inputs". So when you try to access the actionButton in your server with observeEvent(input$modalApply..., it doesn't work because it's looking for modalApply in the inputs$ of its own namespace ("main"), which doesn't exist.

What you need to do is keep the modal in the same namespace as the server function that's calling it. You can do that by passing the ns function directly into the modal UI function from the session.

Instead of passing in an id and then re-generating ns with ns <- NS(id), you can get the current sessions ns function directly with session$ns and then pass it into the UI functions for it to use:

observeEvent(input$settings, {
    showModal(settngsModal(session$ns))
}

...

settngsModal <- function(ns) {
    ...
    footer = modalFooterUI(ns), 
    ...
}

By passing session$ns in this way, you can ensure that the UI elements for the modal will always be in the same namespace as (and thus accessible to) the server function that calls it. You can read more about this here: http://shiny.rstudio.com/articles/modules.html#using-renderui-within-modules


As for your second question, it's just a simple matter of wrapping the rest of the code in your renderPlot in an isolate function. The isolate function makes it so that changes in reactive values inside the isolate don't invalidate the expression and cause it to re-evaluate. Now, the only reactive value that can cause the renderPlot to re-evaluate is the one outside the isolate: input$refreshMainChart:

output$mainChart <- renderPlot({
    input$refreshMainChart  # Take dependency on the 'Refresh' buton
    isolate({
        hist(faithful$eruptions, probability = TRUE, breaks = as.numeric(rv$bins),  
             xlab = "Duration (minutes)", main = "Geyser Eruption Duration")

        dens <- density(faithful$eruptions, adjust = rv$bandwidth)
        lines(dens, col = "blue")
    })
})
like image 110
divibisan Avatar answered Oct 29 '22 04:10

divibisan