How to add columns to table rendered with rhandsontable with dropdown menus using an action button?

Question

I'm working on a table rendered with rhandsontable that uses dropdown menus for user inputs into the table. My dropdown approach is based on guidance provided in post Is there a way to have different dropdown options for different rows in an rhandsontable?. I'm trying to add a feature where the user clicks on an actionButton() in order to add a column to the table and sequentially numbers the header for the added column, with the dropdowns included in the added column. The below code almost works, except that added columns don't have the required dropdowns. What am I doing wrong here?

Code:

library(shiny)
library(rhandsontable)

ui <- fluidPage(br(),
  mainPanel(
    actionButton("add", "Add column"),br(),br(),
    rHandsontableOutput("Tbl")
    )
  )

server <- function(input, output) {
  DF <- reactiveVal(
    data.frame(
      'Series 1' = NA_character_, 
      stringsAsFactors = FALSE,
      row.names = c("Select option"),
      check.names = FALSE
      )
    )
  
  observeEvent(input$Tbl,{DF(hot_to_r(input$Tbl))})
  
  output$Tbl <- renderRHandsontable({
    select_option <- c(NA_character_, "dog", "cat") # defines the dropdown options
    tmp <- rhandsontable(DF(), rowHeaderWidth = 200, selectCallback = TRUE, height = 300) %>%
      hot_cols(colWidths = 100) %>%
      hot_col("Series 1", 
              allowInvalid = FALSE, 
              type = "dropdown", 
              source = NA_character_, 
              readOnly = TRUE
              )
    tmp <- hot_col(tmp, 
                   col = "Series 1", 
                   allowInvalid = FALSE, 
                   type = "dropdown", 
                   source = select_option
                   ) %>% 
      hot_cell(row = input$Tbl_select$select$r, col = "Series 1", readOnly = FALSE)
    tmp
  })
  
  observeEvent(input$add, {
    select_option <- c(NA_character_, "dog", "cat") # defines the dropdown options
    newCol <- data.frame('Series 1' = NA_character_,stringsAsFactors = FALSE)
    names(newCol) <- paste("Series", ncol(hot_to_r(input$Tbl)) + 1)
    DF(cbind(DF(), newCol))
  })
  
}

shinyApp(ui = ui, server = server)

Answer 1

You need to apply hot_col(type = "dropdown") on every column of the reactive data.frame (col = names(DF())) not only on the first col = "Series 1":

library(shiny)
library(rhandsontable)

ui <- fluidPage(br(),
                mainPanel(
                  actionButton("add", "Add column"),br(),br(),
                  rHandsontableOutput("Tbl")
                )
)

server <- function(input, output) {
  DF <- reactiveVal(
    data.frame(
      'Series 1' = NA_character_, 
      stringsAsFactors = FALSE,
      row.names = c("Select option"),
      check.names = FALSE
    )
  )
  
  observeEvent(input$Tbl,{DF(hot_to_r(input$Tbl))})
  
  output$Tbl <- renderRHandsontable({
    select_option <- c(NA_character_, "dog", "cat") # defines the dropdown options
    rhandsontable(DF(), rowHeaderWidth = 200, selectCallback = TRUE, height = 300) %>%
      hot_cols(colWidths = 100) %>% 
      hot_col(col = names(DF()), 
              allowInvalid = FALSE, 
              type = "dropdown", 
              source = select_option
      ) %>% 
      hot_cell(row = input$Tbl_select$select$r, col = "Series 1", readOnly = FALSE)
  })
  
  observeEvent(input$add, {
    select_option <- c(NA_character_, "dog", "cat") # defines the dropdown options
    newCol <- data.frame('Series 1' = NA_character_,stringsAsFactors = FALSE)
    names(newCol) <- paste("Series", ncol(hot_to_r(input$Tbl)) + 1)
    DF(cbind(DF(), newCol))
  })
  
}

shinyApp(ui = ui, server = server)

Answer 2

Following up on ismirsehregal's solution for column addition, the below offers both column addition and deletion via actionButton():

library(shiny)
library(rhandsontable)

ui <- fluidPage(br(),
  mainPanel(
    actionButton("add", "Add column"),br(),br(),
    actionButton("delSeries","Select series below to delete"),
    uiOutput("delSeries2"),
    rHandsontableOutput("Tbl")
    )
  )

server <- function(input, output) {
  DF <- reactiveVal(
    data.frame(
      'Series 1' = NA_character_, 
      stringsAsFactors = FALSE,
      row.names = c("Select option"),
      check.names = FALSE
      )
    )
  
  observeEvent(input$Tbl,{DF(hot_to_r(input$Tbl))})
  
  output$Tbl <- renderRHandsontable({
    select_option <- c(NA_character_, "dog", "cat") # defines the dropdown options
    tmp <- rhandsontable(DF(), rowHeaderWidth = 200, selectCallback = TRUE, height = 300) %>%
      hot_cols(colWidths = 100) %>%
      hot_col("Series 1", 
              allowInvalid = FALSE, 
              type = "dropdown", 
              source = NA_character_, 
              readOnly = TRUE
              )
    tmp <- hot_col(tmp, 
                   col = names(DF()), # adding this is what fixed it 
                   allowInvalid = FALSE, 
                   type = "dropdown", 
                   source = select_option
                   ) %>% 
      hot_cell(row = input$Tbl_select$select$r, col = "Series 1", readOnly = FALSE)
    tmp
  })
  
  observeEvent(input$add, {
    newCol <- data.frame('Series 1' = NA_character_,stringsAsFactors = FALSE)
    names(newCol) <- paste("Series", ncol(hot_to_r(input$Tbl)) + 1)
    DF(cbind(DF(), newCol))
  })
  
  observeEvent(input$delSeries3, {
    tmp <- DF()
    delCol <- input$delSeries3                              
    tmp <- tmp[ , !(names(tmp) %in% delCol), drop = FALSE]  
    newNames <- sprintf("Series %d",seq(1:ncol(tmp)))       
    names(tmp) <- newNames                                  
    DF(tmp)                                         
  })
  
  output$delSeries2 <- 
    renderUI(
      selectInput("delSeries3", 
                  label = NULL,
                  choices = colnames(hot_to_r(input$Tbl)), 
                  selected = "",
                  multiple = TRUE,
                  width = '110px')
    )
  
}

shinyApp(ui = ui, server = server)