Невозможно получить доступ к реактивным объектам внутри функции, используемой для создания динамического блестящего содержимого

Question

Фон

У меня проблема с доступом к реактивному контенту при создании динамического контента для приложения shiny.В частности, у меня есть функция (mk_obj в примере кода ниже), которая создает список функций, используемых для генерации shiny объектов (как пользовательского интерфейса, так и элементов ввода / вывода в функции сервера).Однако функции, содержащиеся в функции mk_obj, не могут ссылаться на реактивные объекты, созданные в функции server(), даже когда лениво вызывается из этой функции в качестве члена объекта output (ошибки, указанные ниже, возникают, когдапользователь нажимает кнопку загрузки).

Специальный вопрос

Как получить доступ к r_data изнутри downloadHandler() ниже, чтобы получить ожидаемый результат и таким образом, чтобы я мог обобщитьк другим функциям вывода (например, 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 файл для загрузки выбранной строки данных, используя ползунок.Вместо этого выбрасываются ошибки, отмеченные в комментариях к коду.

Другие мысли

Хотя существуют простые реализации renderUI() с повторяющимися объявлениями объектов, я пытаюсь автоматически сгенерировать shiny контент, которыйможет не появляться в смежном разделе и хотел бы избежать повторного объявления идентификаторов вручную.Кроме того, я пытаюсь сохранить шаблоны ориентированных на данные (в отличие от презентационных), чтобы я мог использовать фрагменты автоматически сгенерированных shiny объектов через приложение, которое может варьироваться в зависимости от макета / контейнера презентации.

Цените время.

Answer 1

Вы не сможете использовать reactive внутри функции, не передав ее в качестве аргумента.

Я предлагаю использовать Блестящие модули , они были разработаны дляэта конкретная цель.

Как это работает:

Вы можете очень просто передать реактивных в модули:

1. Написать модуль: mk_obj <- function(input, output, session, df) {...}

reactive будет передано в аргумент df.

Используйте реактив в модуле: df()

Вызовите модуль внутри сервера, используя уникальный идентификатор ("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.