r - 无法访问用于生成动态 Shiny 内容的函数内部的 react 对象

Question

背景

在为 shiny 应用程序创建动态内容时，我在访问 react 性内容时遇到问题。具体来说，我有一个函数(下面示例代码中的 mk_obj)创建了一个函数列表，用于生成 shiny 对象(服务器中的 UI 和输入/输出元素)功能)。但是，mk_obj 函数中包含的函数无法引用在 server() 函数中实例化的 react 对象，即使是作为output 对象(当用户点击下载按钮时抛出下面提到的错误)。

具体问题

我如何从下面的 downloadHandler() 中访问 r_data 以获得预期的结果，并以一种我可以推广到其他输出函数的方式(例如 DT::renderDataTable()、renderPlot() 等) ?

代码

以下代码块包含手头问题的工作示例，以及对 xdata 尝试的三个替代分配(通常，似乎 downloadHandler() 函数不能找到 r_data 对象出现的环境)。我遇到了几个 output 渲染对象的问题，而不仅仅是 downloadHandler() 函数:

# 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);

预期输出

对于这个例子，shiny 应用程序应该提供一个 CSV 文件来使用 slider 下载选定的数据行。相反，抛出代码注释中指出的错误。

其他想法

虽然 renderUI() 有简单的实现和重复的对象声明，但我正在尝试自动生成可能不会出现的 Shiny 内容在连续的部分中，并希望避免手动重复声明 ID。此外，我试图使模板以数据为中心(而不是以演示为中心)，以便我可以通过可能因演示布局/容器而异的应用程序使用自动生成的 shiny 对象的片段.

感谢时间。

Answer 1

您将无法使用 reactive在一个函数中，而不将其作为参数传递。

我的建议是使用Shiny modules ，它们是为此特定目的而开发的。

工作原理:

您可以很容易地将reactives 传递给模块:

1. 写一个模块:mk_obj <- function(input, output, session, df) {...}

reactive将传递给 df争论。

1. 在模块内使用响应式(Reactive):df()

2. 使用唯一 ID ("example") 在服务器中调用模块:callModule(module = mk_obj, id = "example", df = r_data)

我完全重写了您的代码，因为它真的很难阅读和理解。

代码:

# 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.: 删除分号，因为它们在 R 中已过时。