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

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)

CodePudding user response：

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)