模块化和 SelectInput 使 actionButton 重复

Posted 2023-03-24

【中文标题】模块化和 SelectInput 使 actionButton 重复

【英文标题】：Modularization and SelectInput make the actionButton repeat

【发布时间】：2021-06-04 10:39:43

【问题描述】：

我正在开发一个模块化的应用程序，并在 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, x, 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, output, session)
  
  observeEvent(input$select,
               callModule(Doc_server,"Tab1",x= input$select))


shinyApp(ui, server)

我觉得我在某个地方犯了一个错误，或者我错过了什么。我希望按钮保留在模块化代码中，如虚拟代码所示。感谢任何帮助或讨论。

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

【参考方案1】：

我的猜测是问题源于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, module_data(), 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, output, session) 
  callModule(Doc_server, "Tab1", x = reactive(input$select))



shinyApp(ui, server)

【讨论】：

这种方法可行，但是有没有办法保存添加的行？