Передача renderUI из модуля Shiny в следующий модуль

Question

Я создаю приложение для отслеживания игровых данных и распространяю его бесплатно, поскольку, похоже, в этом есть потребность (читай: хочу). Приложение сначала вводит, сколько игроков должно быть, а затем реактивно разрешает ввод данных для каждого игрока. Затем я хочу представить все полученные данные в виде таблицы данных, которую можно загрузить на следующей странице.

Недавно я начал модульную разбивку своих приложений для обеспечения чистоты. Хотя по какой-то причине я не могу заставить это работать. Я думаю, это потому, что я пытаюсь передать входные данные renderUI от одного модуля к другому и явно не знаю, как это сделать .

Я получаю следующее сообщение об ошибке:

Error in module(childScope$input, childScope$output, childScope, ...) : 
  object 'player_id' not found

Тем не менее, я получил много разных ошибок в попытке исправить.

Для записи, я проверил: передать ввод renderUI из одного модуля Shiny в другой

и: https://community.rstudio.com/t/modularizing-an-app-with-dynamic-inputs-renderui/1454

которые кажутся близкими ...

Вот очень простой пример с модулями в app.R (в противном случае я их использую).

library(shiny)

######################## -- Data Input Module -- ######################## 
datatrackingUI <- function(id){
  ns <- NS(id)
  fluidPage(
    column(4, offset = 4,
           sliderInput(inputId = ns("players"),
                       label = "How many players do you have?",
                       min = 0,
                       max = 4,
                       value = 4)),
    column(12,
           uiOutput(ns("ui_reactive"))
    )
  )

}

datatracking <- function(input, output, session){
  ns <- session$ns

  output$ui_reactive <- renderUI({
    lapply(seq_len(input$players), function(i){
      column(4,
             wellPanel(
               textInput(inputId = ns("player_id"),
                         label = paste0("Enter the ID for player ", i),
                         placeholder = "Brennan")))})

  })

  df_list <- list(player_id = player_id)
  return(df_list)

}

######################## -- Create Data Table Module -- ######################## 
createTableUI <- function(id){
  ns <- NS(id)

  fluidPage(
    renderUI("some_text_for_now")
  )
}

createTable <- function(input, output, sesssion, df_list){
  ns <- session$ns
  output$some_text_for_now <- renderText({
    print(df_list$player_id())
  })

}



######################## -- Shiny App -- ######################## 
ui <- fluidPage(
  navbarPage("Game",
             tabPanel("Input",
                      hr(),
                      datatrackingUI("create_data")),
             tabPanel("Table",
                      hr(),
                      createTableUI("create_table"))
  )
)

server <- function(input, output, session) {
   df_list <- callModule(datatracking, "create_data")
   callModule(createTable, "create_table", df_list)
}

shinyApp(ui = ui, server = server)

Итак, для теперь я просто пытаюсь показать себе, что у меня есть результат от функции renderUI. Я могу справиться с созданием datatable / нажатием на AWS, как только я получу доступ к входам!

Любая помощь приветствуется! Или, если вы хотите поработать со мной над проектом, это может быть весело! Напишите мне для получения дополнительной информации.

-Бреннан

Answer 1

В вашем коде есть две простые проблемы:

• когда вы определяете df_list в модуле datatracking, вы не используете input, поэтому нет ничего реактивного. Вместо этого вы должны сделать:

 df_list <- list(
    player_id = reactive(input$player_id)
  )

• там 3 s в session, когда вы определяете модуль createTable, поэтому вам нужно исправить эту опечатку.

Полный рабочий пример:

library(shiny)

######################## -- Data Input Module -- ######################## 
datatrackingUI <- function(id){
  ns <- NS(id)
  fluidPage(
    column(4, offset = 4,
           sliderInput(inputId = ns("players"),
                       label = "How many players do you have?",
                       min = 0,
                       max = 4,
                       value = 4)),
    column(12,
           uiOutput(ns("ui_reactive"))
    )
  )

}

datatracking <- function(input, output, session){
  ns <- session$ns

  output$ui_reactive <- renderUI({
    lapply(seq_len(input$players), function(i){
      column(4,
             wellPanel(
               textInput(inputId = ns("player_id"),
                         label = paste0("Enter the ID for player ", i),
                         placeholder = "Brennan")))})

  })

  df_list <- list(
    player_id = reactive(input$player_id)
  )
  return(df_list)

}

######################## -- Create Data Table Module -- ######################## 
createTableUI <- function(id){
  ns <- NS(id)

  fluidPage(
    renderUI("some_text_for_now")
  )
}

createTable <- function(input, output, session, df_list){
  ns <- session$ns
  output$some_text_for_now <- renderText({
    print(df_list$player_id())
  })

}



######################## -- Shiny App -- ######################## 
ui <- fluidPage(
  navbarPage("Game",
             tabPanel("Input",
                      hr(),
                      datatrackingUI("create_data")),
             tabPanel("Table",
                      hr(),
                      createTableUI("create_table"))
  )
)

server <- function(input, output, session) {
  df_list <- callModule(datatracking, "create_data")
  callModule(createTable, "create_table", df_list = df_list)
}

shinyApp(ui = ui, server = server)