模块化和 SelectInput 使 actionButton 重复

问题描述

我正在开发一个模块化的应用程序，并且在 Shiny 中包含一个 selectInput 下拉菜单。下拉菜单在选择时提供了不同的数据集。但是，如果我使用按钮添加新行或编辑表格，它会影响两个表格。

请在下面找到虚拟代码。都可以复制运行来演示问题：

                                          ###Modularized Code###

Doc_UI <- function(id){
  ns<-NS(id)
  tagList(
    actionButton(ns("add_btn"),"Add Row",icon("plus-circle"),style="color: #fff; background-color: #337ab7; border-color: #202020;float:left;margin-right:5px"),DTOutput(ns('Table')))
}


Doc_server <-function(input,output,session,x){
  
  if(x == "iris"){
    x <- iris
  }else{
    x<-mtcars
  }
  
  output$Table = renderDT(head(x),selection = 'single',editable = TRUE)
  
  proxy = dataTableProxy('Table') 
  
  observeEvent(input$Table_cell_edit,{
    info = input$Table_cell_edit
    str(info)
    i = info$row
    j = info$col
    v = info$value
    x[i,j] <<- v
    
    replaceData(proxy,x,resetPaging = FALSE) }) 
  
  
  observeEvent(input$add_btn,{newrow <- setNames(data.frame(matrix(ncol = ncol(x),nrow = 1)),colnames(x))
               x<<-rbind(newrow,x)
               rownames(x) <- NULL
               replaceData(proxy,resetPaging = F)
               })
}

                                                ###App###

library(shiny)

ui <- fluidPage(
  dashboardslider <- dashboardSidebar(
    selectInput("select",label = "Select Data",choices = c("iris","mtcars")
                )),dashboardbody <- dashboardBody(
    tabsetPanel(
      tabPanel("Doc",Doc_UI("Tab1")))
  ))

server <- function(input,session)
  
  observeEvent(input$select,{callModule(Doc_server,"Tab1",x= input$select)})


shinyApp(ui,server)

我觉得我在某个地方犯了一个错误或者我遗漏了什么。我希望按钮仍然存在于模块化代码中，如假人所示。感谢任何帮助或讨论。

我认为这可能是由于相同的命名空间，因为两者的 id 都是“Tab1”。有没有办法让 id 在 UI 中具有交互性？

解决方法

我的猜测是问题源于input$add_btn。由于您始终使用相同的命名空间，因此该按钮的输入仍然存在。如果你第一次用 iris 使用它，它的值不是 0。因此，当你再次初始化模块时，observeEvent(input$add_btn 会直接触发。您还可以注意到，无论您在模块的先前版本中单击它的频率如何，如果再次初始化该模块，您只会有一个新行。

在下面的代码版本中，我只初始化模块一次，但更改模块内的数据集，具体取决于来自主服务器功能的反应性输入。请注意，如果您更改数据集，则不会保存添加的行。

library(shiny)
library(shinydashboard)
library(DT)

Doc_UI <- function(id){
  ns<-NS(id)
  tagList(
    actionButton(ns("add_btn"),"Add Row",icon("plus-circle"),style="color: #fff; background-color: #337ab7; border-color: #202020;float:left;margin-right:5px"),DTOutput(ns('Table')))
}


Doc_server <-function(input,output,session,x){
  # set up reactiveVal
  module_data <- reactiveVal()
  observeEvent(x(),{
    if(x() == "iris"){
      module_data(iris)
    }else{
      module_data(mtcars)
    }
  })

  output$Table = renderDT({
    req(module_data())
    head(module_data())},selection = 'single',editable = TRUE)

  proxy = dataTableProxy('Table')

  observeEvent(input$Table_cell_edit,{
    info = input$Table_cell_edit
    str(info)
    i = info$row
    j = info$col
    v = info$value
    cur_data <- module_data()
    cur_data[i,j] <- v
    module_data(cur_data)

    replaceData(proxy,module_data(),resetPaging = FALSE) })


  observeEvent(input$add_btn,{newrow <- setNames(data.frame(matrix(ncol = ncol(module_data()),nrow = 1)),colnames(module_data()))
               cur_data <- rbind(newrow,module_data())
               rownames(cur_data) <- NULL
               module_data(cur_data)
               replaceData(proxy,resetPaging = F)
               })
}

###App###

library(shiny)

ui <- fluidPage(
  dashboardslider <- dashboardSidebar(
    selectInput("select",label = "Select Data",choices = c("iris","mtcars")
    )),dashboardbody <- dashboardBody(
    tabsetPanel(
      tabPanel("Doc",Doc_UI("Tab1")))
  ))

server <- function(input,session) {
  callModule(Doc_server,"Tab1",x = reactive({input$select}))
}


shinyApp(ui,server)