Unable to access reactive objects inside function used to generate dynamic shiny content

user_10136488 0
Viewed 989

Background

I am having an issue accessing reactive content when creating dynamic content for a shiny app. Specifically, I have a function (mk_obj in the sample code below) that creates a list of functions used to generate shiny objects (both UI and input/output elements in the server function). However, the functions contained within the mk_obj function are unable to reference reactive objects instantiated within the server() function, even when lazily invoked from within that function as a member of the output object (the errors noted below are thrown when a user clicks on the download button).

Specific Question

How can I access r_data from within downloadHandler() below to arrive at the expected result and in a manner that I can generalize to other output functions (e.g. DT::renderDataTable(), renderPlot(), etc.) ?

Code

The following code block contains a working example of the issue at hand, along with three alternative assignments to xdata attempted (generally, appears that the downloadHandler() function cannot locate the environment in which the r_data object appears). I have encountered the issue with several output rendering objects, not just the downloadHandler() function:

# Libraries
library(tidyverse);
library(shiny);
library(shinydashboard);

# Data
srcdata <- tibble::as_tibble(list(a=1:100,b=101:200,c=201:300));

# Functions -- R Worker
mk_obj <- function() {
  attr <- list(items=c('a'));
  list(
    server_output=list(
      dl_data=function() {
        x <- lapply(attr$items, function(x) {
          downloadHandler(
            filename = function() { paste('file.csv') },
            content  = function(con) {
              xdata <- r_data(); # <<< Error: "Error in r_data: could not find function "r_data""
#             xdata <- match.fun('r_data')(); # <<< Error: "Error in get: object 'r_data' of mode 'function' was not found"
#             xdata <- eval(parse(text='r_data'))(); # <<< Error: "Error in eval: object 'r_data' not found"
              write.csv(xdata, con);
            },
            contentType='text/csv'
          );
        })
        names(x) <- sprintf('dl_%s',tolower(attr$items));
        return(x);
      }
    ),
    ui_tabitems= lapply(attr$items, function(x) {
      tabItem(tabName=sprintf('tab%s',tolower(x)), downloadButton(outputId=sprintf('dl_%s',tolower(x)), label='Download'))
    })
  );
};

# Dynamic shiny objects
dynamic_content <- list(obj1=mk_obj());

# Server
server <- function(input, session, output) {
  r_data <- reactive({srcdata[c(input$row_select),]})
  output$srcdata_out <- renderDataTable({r_data()});
  # dynamic_content <- list(obj1=mk_obj()); # <-- Have attempted invocation here, instead of outside the server() function, with same effect (as expected)
  invisible(lapply(c(dynamic_content$obj1$server_output),
                  function(x) {
                xouts <- x();
                for (i in paste0(names(xouts))) {
                      output[[i]] <<- xouts[[i]];
                };
              }));
}

# UI
ui <- dashboardPage(
  dashboardHeader(title = "POC"),
  dashboardSidebar(sidebarMenu(id = "tabs",
      menuItem("Menu1",  tabName = "taba"),
      menuItem("Menun",  tabName = "tabn", selected=TRUE)
      )
  ),
  dashboardBody(
    do.call('tabItems',append(list(
      tabItem(tabName="tabn", fluidRow(sliderInput( inputId='row_select', label='rowID', min=1, max=NROW(srcdata), value=10)),
                          hr(),
                          fluidRow(dataTableOutput('srcdata_out')))),
      dynamic_content$obj1$ui_tabitems)))
);

# App
shinyApp(ui=ui,server=server);

Expected Output

For this example, the shiny app should offer a CSV file to download the selected row of data, using the slider. Instead, the errors noted in the code comments thrown.

Other Thoughts

While there are straightforward implementations of renderUI() with repetitive object declarations, I am attempting to automatically generate shiny content that may not appear in a contiguous section and would like to avoid repetitively declaring IDs manually. Additionally, I am trying to keep templates data-centric (as opposed to presentation-centric) such that I can use pieces of the auto-generated shiny objects through an application that may vary by presentation layout/ container.

Appreciate the time.

shiny r
1 Answers

You won't be able to use a reactive within a function, without passing it as an argument.

My suggestion is to use Shiny modules, they were developed for this particular purpose.

How it works:

You can pass reactives to modules quite easily:

  1. Write a module: mk_obj <- function(input, output, session, df) {...}

The reactive will be passed to the df argument.

  1. Use the reactive within the module: df()

  2. Call the module within Server using a unique id ("example"): callModule(module = mk_obj, id = "example", df = r_data)

I completely rewrote your code as it's really hard to read and understand.

Code:

# Libraries
library(tidyverse)
library(shiny)
library(shinydashboard)

# Data
srcdata <- tibble::as_tibble(list(a=1:100,b=101:200,c=201:300))

# Functions -- R Worker

## UI part of the module
mk_obj_ui <- function(id) {
  ns <- NS(id)
  downloadButton(ns("download_btn"), label = "Download")
}

# Server part of the module reactive will be passed to the df argument
mk_obj <- function(input, output, session, df) {
  output$download_btn <- downloadHandler(
    filename = "file.csv",
    content  = function(file) {
      write.csv(df(), file, row.names = FALSE)
    },
    contentType='text/csv'
  )
}

# Server
server <- function(input, session, output) {
  r_data <- reactive( {
    srcdata[c(input$row_select), ]
  })
  output$srcdata_out <- renderDataTable( {
    r_data()
  })

  # Call the module with the id: example. Pass the reactive r_data as df.
  ## Note that brackets should not be used when passing a reactive to the module!
  callModule(module = mk_obj, id = "example", df = r_data)
}

# UI
ui <- dashboardPage(
  dashboardHeader(title = "POC"),
  dashboardSidebar(sidebarMenu(id = "tabs",
                               menuItem("Menu1",  tabName = "taba"),
                               menuItem("Menun",  tabName = "tabn", selected=TRUE)
  )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "taba",
              mk_obj_ui("example")
      ),
      tabItem(tabName="tabn", 
              sliderInput(inputId='row_select', label='rowID', min=1, max=NROW(srcdata), value=10),
              hr(),
              dataTableOutput('srcdata_out')
      ) 
    )
  )
)

# App
shinyApp(ui=ui,server=server)

PS.: Drop the semicolons as they are obsolete in R.

user_45090960
Related