Modularization and SelectInput make the actionButton repeat

Question

I am working on an app that is modularized and contains a selectInput dropdown in Shiny. The dropdown provides a different dataset on selecting it. However, if I add a new row using the button or edit the table it effects both the tables.

Please find the dummy code below. It can all be copied and run to demonstrate the problem:

                                          ###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)

I feel like I am making a mistake somewhere or I am missing something. I want the buttons to remain present in the modularized code as shown in the dummy. Appreciate any help or discussion.

I think this might be due to the same namespace, as the id is "Tab1" for both. Is there a way to make the id interactive in the UI?

Answer 1

My guess is that the problem stems from input$add_btn. Because you always use the same namespace, the input for this button is still there. If you've used it the first time with iris, its value is not 0. Therefore, when you initialise the module again, the observeEvent(input$add_btn directly fires. You can also notice that it doesn't matter how often you've clicked it in the previous version of the module, if you initialise the module again you only have one new row.

Below you find a version of the code where I only initialise the module once but change the dataset within the module, depending on the reactive input from the main server function. Notice that if you change the dataset, the added rows are not saved.

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)