Сделать блестящий модуль реактивным

#r #shiny #shiny-reactivity #shinymodules

#r #блестящий #блестящий -реактивность #shinymodules

Вопрос:

В приведенном ниже примере приложения есть два блестящих модуля. Первый модуль отображает таблицу со случайно сгенерированными значениями, а также кнопку действия, при нажатии на которую генерируются новые значения. Второй модуль отображает набор данных, сгенерированный в первом.

Как мне изменить вторую таблицу с первой?

Спасибо.

app.R

 library(shiny)
source("modules.R")

ui <- fluidPage(

  fluidRow(
    column(6, table1_moduleUI("table1")),
    column(6, table2_moduleUI("table2"))

  )

)

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

  table1 <- callModule(table1_module, "table1")
  callModule(table2_module, "table2", table_data = table1$values)
}

shinyApp(ui, server)
  

modules.R

 # Module for table 1

table1_moduleUI <- function(id){
  ns <- NS(id)

  tagList(
    tableOutput(ns("table")),
    actionButton(ns("submit"), label = "Change values")
  )
}

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

  table <- reactiveValues()

  observeEvent(input$submit, {
    table$values <- replicate(3, rnorm(10))
  }, ignoreNULL = FALSE)

  output$table <- renderTable({
    table$values
  })

  return(table)
}

# Module for table 2

table2_moduleUI <- function(id){

  ns <- NS(id)
  tableOutput(ns("table"))
}

table2_module <- function(input, output, session, table_data){

  output$table <- renderTable({
    table_data
  })
}
  

Комментарии:

1. Похоже, что код для второго модуля отсутствует.

Ответ №1:

Второй модуль, похоже, отсутствует в вопросе, но логика кажется простой. Проблема здесь в том, что вы передаете value реактивное выражение второму модулю при использовании,

callModule(table2_module, "table2", table_data = table1$values)

вместо этого вы хотите передать реактивное значение, которое сообщает R аннулировать выходные данные при изменении реактивных значений,

callModule(table2_module, "table2", table_data = table1)

вот полное приложение,

 library(shiny)

# Module for table 1

table1_moduleUI <- function(id){
  ns <- NS(id)

  tagList(
    tableOutput(ns("table")),
    actionButton(ns("submit"), label = "Change values")
  )
}

table2_moduleUI <- function(id){
  ns <- NS(id)
  tableOutput(ns("table"))
}

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

  table <- reactiveValues()

  observeEvent(input$submit, {
    table$values <- replicate(3, rnorm(10))
  }, ignoreNULL = FALSE)

  output$table <- renderTable({
    table$values
  })

  return(table)
}

table2_module <- function(input, output, session,table_data) {

  output$table <- renderTable({
    table_data
  })

}


ui <- fluidPage(

  fluidRow(
    column(6, table1_moduleUI("table1")),
    column(6, table2_moduleUI("table2"))
  )

)

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

  table1 <- callModule(table1_module, "table1")
  callModule(table2_module, "table2", table_data = table1$values)
}

shinyApp(ui, server)
  

В качестве предостережения, если вы хотите отобразить фрейм данных, использование реактивных значений кажется излишним. Когда мы хотим вернуть реактивное выражение, вместо инициализации реактивной переменной и установки ее в observer мы можем просто использовать reactive() or eventReactive() , для этого они и существуют! Итак, давайте воспользуемся этим. Реактивные значения имеют свое пространство и, по моему опыту, используются относительно экономно.

 library(shiny)

# Module for table 1

table1_moduleUI <- function(id){
  ns <- NS(id)

  tagList(
    tableOutput(ns("table")),
    actionButton(ns("submit"), label = "Change values")
  )
}

table2_moduleUI <- function(id){
  ns <- NS(id)
  tableOutput(ns("table"))
}

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

  table = eventReactive(input$submit, {
    replicate(3, rnorm(10))
  }, ignoreNULL = FALSE)

  output$table <- renderTable({
    table()
  })

  return(table)
}

table2_module <- function(input, output, session,table_data) {

  output$table <- renderTable({
    table_data()
  })

}


ui <- fluidPage(

  fluidRow(
    column(6, table1_moduleUI("table1")),
    column(6, table2_moduleUI("table2"))
  )

)

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

  table1 <- callModule(table1_module, "table1")
  callModule(table2_module, "table2", table_data = table1)
}

shinyApp(ui, server)