时间戳

首页 > 解决方案 > 模块化和 SelectInput 使 actionButton 重复

r - 模块化和 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, 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 中交互？

标签： rshinyselectinputmodularization

解决方案

我的猜测是问题源于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)

推荐阅读