r - 闪亮的反应值错误，模块中的表不响应 selectInput 选择（input$var）

Question

最近我一直在尝试开发一个使用 2 个导入表并创建反映前两个表总和的第三个表的 Shiny 应用程序。此外，我还尝试通过 selectInput 表达式中的 input$choice 过滤导入的表。

我目前遇到的问题是表模块中的这一行：

data <- reactiveValues(table = test[test$num == reactive({input$var}),])

如果我用 test$num 中存在的整数替换 reactive({input$var})，代码将运行，所以我想我只是不确定如何将 input$var 值作为整数调用？谁能帮我解决这个问题？代码在下面，并使用来自 base R 的已编辑 mtcars 数据集。

### Libraries
library(shiny)
library(dplyr)
library(DT)

### Data----------------------------------------
set.seed(0)
x <- data.frame(num = rep(c(1:5),2))
test <- cbind(mtcars, x)

module1 <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      # initialise the reactive data object for the table
      data <- reactiveValues(table = test[test$num == reactive({input$var}),])
      
      # render the table
      output$table <- renderDT({
        datatable(data$table,
                  editable = TRUE)
      })
      
      # update the underlying data
      observeEvent(input$table_cell_edit, {
        data$table <- editData(data$table, input$table_cell_edit)
      })
      
      # return the data as a reactive
      return(reactive(data$table))
    }
  )
}

module2 <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      # initialise the reactive data object for the table
      data <- reactiveValues(table = test[test$num == reactive({input$var}),])
      
      # render the table
      output$table <- renderDT({
        datatable(data$table,
                  editable = TRUE)
      })
      
      # update the underlying data
      observeEvent(input$table_cell_edit, {
        data$table <- editData(data$table, input$table_cell_edit)
      })
      
      # return the data as a reactive
      return(reactive(data$table))
    }
  )
}

module_add <- function(id, data_input_1, data_input_2) {
  moduleServer(
    id,
    function(input, output, session) {
      # do the calculations
      data_table <- reactive({
        data_input_1() + data_input_2()
      })
      
      # render the table
      output$table <- renderDT({
        datatable(data_table())
      })
    }
  )
}

modFunctionUI <- function(id) {
  ns <- NS(id)
  
  selectInput(ns("var"), "Variable", choices = test$num)
  dataTableOutput(ns("table"))
}

ui <- fluidPage(
  modFunctionUI("table_1"),
  modFunctionUI("table_2"),
  modFunctionUI("table_3")
)

server <- function(input, output, session) {
  # call the modules for the editable tables and store the results
  amptable <- module1("table_1")
  refreshtable <- module2("table_2")
  
  # call the module for the table that takes inputs
  # the reactives musn't be evaluated
  module_add("table_3",
                data_input_1 = amptable,
                data_input_2 = refreshtable)
}

shinyApp(ui, server)```


EDIT: Could you explain how the call works? In my module when I add another argument to my module function and use reactive({input$var}), an error comes up 

Error in ==: comparison (1) is possible only for atomic and list types. 

I guess this is an issue with how I'm calling the input$var from the main UI but I don't quite understand how the modules interpret the input values.


module1 <- function(id, choice) {

data <- reactiveValues()
      observeEvent(choice, {data$table <- test[test$num == as.numeric(choice),]}, ignoreInit = FALSE)

}
 
ui <- fluidPage(
  selectInput("var",
              "Variable",
              choices = test$num,
              selected = NULL),
  modFunctionUI("table_1"),
  modFunctionUI("table_2"),
  modFunctionUI("table_3")
)
          
server <- function(input, output, session) {
  # call the modules for the editable tables and store the results
  amptable <- module1("table_1", reactive({input$var}))
}

标签： rshiny

Answer 1

除了使用as.numeric(input$var). 尝试这个

### Libraries
library(shiny)
library(dplyr)
library(DT)

### Data----------------------------------------
set.seed(0)
x <- data.frame(num = rep(c(1:8),4))
test <- cbind(mtcars, x)

module1 <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      # initialise the reactive data object for the table
      #data <- reactiveValues(table = test[test$num == reactive({input$var}),])
      data <- reactiveValues()
      observeEvent(input$var, {data$table <- test[test$num == as.numeric(input$var),]}, ignoreInit = FALSE)
      # render the table
      output$table <- renderDT({
        #data$table <- test[test$num == as.numeric(input$var),]
        datatable(data$table,
                  editable = TRUE)
      })
      
      # update the underlying data
      observeEvent(input$table_cell_edit, {
        info = input$table_cell_edit
        str(info)
        i = info$row
        j = info$col
        v = info$value
        data$table[i, j] <<- (DT::coerceValue(v, data$table[i, j]))
        # data$table <<- editData(data$table, info)
      })
      
      # return the data as a reactive
      return(reactive(data$table))
    }
  )
}

module2 <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      # initialise the reactive data object for the table
      # data <- reactiveValues(table = test[test$num == reactive({input$var}),])
      data <- reactiveValues()
      observeEvent(input$var, {data$table <- test[test$num == as.numeric(input$var),]}, ignoreInit = FALSE)
      # render the table
      output$table <- renderDT({
        datatable(data$table,
                  editable = TRUE)
      })
      
      # update the underlying data
      observeEvent(input$table_cell_edit, {
        info = input$table_cell_edit
        str(info)
        i = info$row
        j = info$col
        v = info$value
        data$table[i, j] <<- (DT::coerceValue(v, data$table[i, j]))
        #data$table <<- editData(data$table, info)
      })
      
      # return the data as a reactive
      return(reactive(data$table))
    }
  )
}

module_add <- function(id, data_input_1, data_input_2) {
  moduleServer(
    id,
    function(input, output, session) {
      # do the calculations
      data_table <- reactive({
        rbind(data_input_1(),data_input_2())
      })
      
      # render the table
      output$table <- renderDT({
        datatable(data_table())
      })
    }
  )
}

modFunctionUI <- function(id) {
  ns <- NS(id)
  tagList(
    selectInput(ns("var"), "Variable", choices = unique(test$num) ),
    dataTableOutput(ns("table"))
  )
  
}

ui <- fluidPage(
  modFunctionUI("table_1"),
  modFunctionUI("table_2"),
  modFunctionUI("table_3")
)

server <- function(input, output, session) {
  # call the modules for the editable tables and store the results
  amptable <- module1("table_1")
  refreshtable <- module2("table_2")
  
  # call the module for the table that takes inputs
  # the reactives musn't be evaluated
  module_add("table_3",
             data_input_1 = amptable,
             data_input_2 = refreshtable)
}

shinyApp(ui, server)