Search code examples
rshinyshiny-reactivityrhandsontable

How to insert a reactive value into rhandsontable?


I'm trying to insert a reactive value, from a separate user input, into a table rendered using rhandsontable. An example code is posted at the bottom of this post. Immediately below is an image that best explains what I'm trying to do. Any recommendations for how to do this?

enter image description here

Code:

library(rhandsontable)
library(shiny)
library(shinyjs)

mydata <- data.frame('Series 1' = c(1,12,0,1), check.names = FALSE)
rownames(mydata) <- c('Term A','Term B','Term C','Term D') 

ui <- fluidPage(
  useShinyjs(), 
  br(),
  uiOutput("choices"),
  rHandsontableOutput('hottable')
)

server <- function(input, output) {
  uiTable <- reactiveVal(mydata)
  
  observeEvent(input$hottable, {uiTable(hot_to_r(input$hottable))})
  
  output$hottable <- renderRHandsontable({
    rhandsontable(uiTable(),rowHeaderWidth = 100, useTypes = TRUE)%>%
      hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE) %>%
      hot_cols(
        colWidths = 80,
        renderer = "function(instance, td, row, col, prop, value, cellProperties) {
           Handsontable.renderers.NumericRenderer.apply(this, arguments);
           if(instance.params && 1 === row) {td.style.background = '#eff0f1'} // shade row 2 only
         }"
      ) %>%
    hot_row(c(2), readOnly = TRUE)  # makes row 2 non-editable
  })
  
  output$choices <- 
    renderUI(
      selectInput(
        "choices", 
        label = "User selects value to reflect in row 2 of table below:",
        choices = c(1,2,3)
      )
    )

}

shinyApp(ui,server)

Solution

  • We can add another observeEvent to modify the reactiveVal uiTable:

    library(rhandsontable)
    library(shiny)
    library(shinyjs)
    
    mydata <- data.frame('Series 1' = c(1,1,0,1), check.names = FALSE)
    rownames(mydata) <- c('Term A','Term B','Term C','Term D') 
    
    ui <- fluidPage(
      useShinyjs(), 
      br(),
      uiOutput("choices"),
      rHandsontableOutput('hottable')
    )
    
    server <- function(input, output) {
      uiTable <- reactiveVal(mydata)
      
      observeEvent(input$hottable, {uiTable(hot_to_r(input$hottable))})
      
      output$hottable <- renderRHandsontable({
        rhandsontable(uiTable(),rowHeaderWidth = 100, useTypes = TRUE)%>%
          hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE) %>%
          hot_cols(
            colWidths = 80,
            renderer = "function(instance, td, row, col, prop, value, cellProperties) {
               Handsontable.renderers.NumericRenderer.apply(this, arguments);
               if(instance.params && 1 === row) {td.style.background = '#eff0f1'} // shade row 2 only
             }"
          ) %>%
          hot_row(c(2), readOnly = TRUE)  # makes row 2 non-editable
      })
      
      output$choices <- 
        renderUI({
          selectInput(
            "choices", 
            label = "User selects value to reflect in row 2 of table below:",
            choices = c(1,2,3)
          )
        })
      
      observeEvent(input$choices, {
        tmpTable <- uiTable()
        tmpTable$`Series 1`[2L] <- as.numeric(input$choices)
        uiTable(tmpTable)
      })
      
    }
    
    shinyApp(ui,server)
    

    PS: are you aware of the fact, that you can embed dropdowns directly in rhandsontable? Please check this answer.