0

I'm trying to adapt the answer to post Is there a way to have different dropdown options for different rows in an rhandsontable? to my situation in the below code. I would like the first two rows of the rendered table to require the user to input numeric values manually (in the fuller code this is derived from, the user is able to manually input numeric values in place of the rendered default values), and the last row (row name "select_option") to require a selection in the dropdown. Currently, the below code only offers dropdowns for all rows in the column.

Is this possible? (First 2 rows manual inputs of numeric values, last row dropdown).

From my review of the package documentation for rhandsontable, the function hot_row() is far more limited than hot_col(). Also, an added twist is the larger App this is intended for allows the addition of columns via actionButton() and I would need the added columns to also have the same dropdown for this one "selection_option" row.

Code:

library(shiny)
library(rhandsontable)

ui <- fluidPage(hr(),mainPanel(rHandsontableOutput("ExampleTable")))

server <- function(input, output) {
  
  DF <- reactiveVal(data.frame(Object = c("enter_data", "enter_data", "select_option"), Needs = NA_character_, stringsAsFactors = FALSE))
  
  observeEvent(input$ExampleTable, {
    DF(hot_to_r(input$ExampleTable))
  })
  
  output$ExampleTable <- renderRHandsontable({
    
    select_optionOptions <- c(NA_character_, "dog", "cat") # defines the dropdown options
    
    tmpExampleTable <- rhandsontable(DF(), rowHeaders = NULL, stretchH = "all", selectCallback = TRUE, width = 300, height = 300) %>%
      hot_col("Object", readOnly = TRUE) %>%
      hot_col("Needs", allowInvalid = FALSE, type = "dropdown", source = NA_character_, readOnly = TRUE)
    
    if(!is.null(input$ExampleTable_select$select$r)){
      
      selectedObject <- DF()[input$ExampleTable_select$select$r, "Object"]
      
      if(selectedObject == "select_option"){
        tmpExampleTable <- hot_col(tmpExampleTable, col = "Needs", allowInvalid = FALSE, type = "dropdown", source = select_optionOptions) %>% hot_cell(row = input$ExampleTable_select$select$r, col = "Needs", readOnly = FALSE)
      }
    }
    tmpExampleTable
    
  })
}

shinyApp(ui = ui, server = server)
Village.Idyot
  • 1,359
  • 2
  • 8

1 Answers1

0

From my research it seems it is not readily possible in rhandsontable to have one row with dropdown feature and other rows in the same table with manual overwrite of values at least by using hotcols() or hotrow() the latter of which is particularly limited with its options.

Please advise if you disagree.

In any case, a reasonable alternative is to break the single table out two into two tables running in parallel, with one table presenting values that can be overwritten by the user and the other table with dropdown of specified items. See code below that does this:

library(shiny)
library(rhandsontable)

ui <- fluidPage(hr(),
        mainPanel(
          rHandsontableOutput("Tbl1"),
          br(),
          rHandsontableOutput("Tbl2")
        )
      )

server <- function(input, output) {
  DF1 <- reactiveVal(data.frame(Object = c("enter_data", "enter_data"), Needs = c(10,20))) 
  DF2 <- reactiveVal(data.frame(Object = c("select_option"), Needs = NA_character_, stringsAsFactors = FALSE))
  
  observeEvent(input$Tbl1,{DF1(hot_to_r(input$Tbl1))})
  observeEvent(input$Tbl2,{DF2(hot_to_r(input$Tbl2))})
  
  output$Tbl1 <- renderRHandsontable({
    tmp1 <- rhandsontable(DF1(),rowHeaders=NULL,useTypes=TRUE)%>%
      hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE) %>%
      hot_cols(colWidths = 100)
    tmp1
  })
  
  output$Tbl2 <- renderRHandsontable({
    select_option <- c(NA_character_, "dog", "cat") # defines the dropdown options
    
    tmp2 <- rhandsontable(DF2(), rowHeaders = NULL, selectCallback = TRUE, height = 300) %>%
      hot_cols(colWidths = 100) %>%
      hot_col("Object", readOnly = TRUE) %>%
      hot_col("Needs", allowInvalid = FALSE, type = "dropdown", source = NA_character_, readOnly = TRUE)
    
    if(!is.null(input$Tbl2_select$select$r)){
      selectedObject <- DF2()[input$Tbl2_select$select$r, "Object"]
      if(selectedObject == "select_option"){
        tmp2 <- hot_col(tmp2, col = "Needs", allowInvalid = FALSE, type = "dropdown", source = select_option) %>% 
          hot_cell(row = input$Tbl2_select$select$r, col = "Needs", readOnly = FALSE)
      }
    }
    tmp2
  })
}

shinyApp(ui = ui, server = server)
Village.Idyot
  • 1,359
  • 2
  • 8