Shiny: Making RHandsontable read only on click

Question

I want to make my rhandsontable read only on clicking the action button 'Freeze Forecast' and activate the table on clicking on 'Edit Forecast'. It should show me the Sum Output on clicking on 'Generate Forecast' button.

Please help to correct my existing code as per above conditions.

UI.R

packages <- c( "shiny", "data.table", "devtools", "shinysky","googleVis","scales","rhandsontable" )
lapply( packages, require, character.only = TRUE )

jsResetCode <- "shinyjs.reset = function() {history.go(0)}" #JS Code to refresh the App

did_recalc <- FALSE

ui <- fluidPage(
  # Application title
  titlePanel("Scenario Planner Test App"),

    br(),br(),
  actionButton("recalc", "Generate Forecast"),
  actionButton("edit", "Edit Forecast"),
  actionButton("freeze", "Freeze Forecast"),br(),br(),
  rHandsontableOutput('table'),br(),br(),
  textOutput('restitle'),
  textOutput('result')

)

Server.R

Sys.setenv(R_ZIPCMD="/usr/bin/zip")
packages <- c( "shiny", "data.table", "devtools", "shinysky","googleVis","scales","reshape2" )
lapply( packages, require, character.only = TRUE )

disableActionButton <- function(id,session) {
  session$sendCustomMessage(type="jsCode1",
                            list(code= paste("$('#",id,"').prop('disabled',true)"
                                             ,sep="")))
}

enableActionButton <- function(id,session) {
  session$sendCustomMessage(type="jsCode2",
                            list(code= paste("$('#",id,"').prop('disabled',false)"
                                             ,sep="")))
}


shiny::shinyServer( function(input,output,session)({
  values <- reactiveValues(data=as.data.frame(runif(2)))

  observe({
    input$recalc
    values$data <- as.data.frame(runif(2))
  })

  observe({
    if(!is.null(input$table))
     values$data <- hot_to_r(input$table)
  })


  output$table <- renderRHandsontable({
    rhandsontable(values$data)
    })

  observe({
    input$freeze
    print("freeze")
    ##if(!is.null(input$table))
    print("2freeze")
    rhandsontable(values$data)  %>%
    hot_table(readOnly = TRUE)
  })


  output$restitle <- renderText({ 
          "Sum Output"
     })

  output$result <- renderText({ 
    sum(values$data)
  })
}) 
)

Answer 1

I got this to work by

• Adding a state variable to your reactive called readonly

• Adding two observerEvent routines to the edit and freeze action buttions to toggle readonly.

• Modifying your output$table command to use the reactive readonly variable.

It would have been easier, and not needed a lot of those elements if you had just used a checkbox to indicate that the table is editable, and then wired that variable to the readOnly parameter, but sometimes you need to do it this way, so I solved it like this.

The complete server.R code is here:

packages <- c("shiny","data.table","devtools","shinysky","googleVis","scales","reshape2")
lapply(packages,require,character.only = TRUE)

disableActionButton <- function(id,session) {
  session$sendCustomMessage(type = "jsCode1",
                            list(code = paste("$('#",id,"').prop('disabled',true)"
                                             ,sep = "")))
}

enableActionButton <- function(id,session) {
  session$sendCustomMessage(type = "jsCode2",
                            list(code = paste("$('#",id,"').prop('disabled',false)"
                                             ,sep = "")))
}


shiny::shinyServer(function(input,output,session)({

  values <- reactiveValues(data = as.data.frame(runif(2)),readonly=FALSE)

  observe({
    input$recalc
    values$data <- as.data.frame(runif(2))
  })

  observe({
    if (!is.null(input$table))
      values$data <- hot_to_r(input$table)
  })


  output$table <- renderRHandsontable({
    rhandsontable(values$data,readOnly=values$readonly)
  })

  observeEvent(input$edit, {
   values$readonly <- FALSE
  })

  observeEvent(input$freeze,{
    values$readonly <- TRUE
  })


  output$restitle <- renderText({
    "Sum Output"
  })

  output$result <- renderText({
    sum(values$data)
  })
})
)

and it looks like this: