How do I make a rhandsontable reactive on both data upload as well as user edits?

[radmuzom]

In my application, I want to allow the user to upload a CSV file and choose a specific set of columns for further treatment.

To do this, I obtain the column names from the uploaded file and display a checkbox against each column name using rhandsontable. I need to store the details of which columns should be treated.

My problem is that I am able to solve the individual problems in the question. I know how to store the rhandsontable in the back-end if an edit is made (as described here). In the example app below, I know how to update the display of the column names and checkboxes if new data is uploaded.

However, I am unable to solve the problem of doing both - that is to store the list of columns in the back-end when an user-edit is made while also allowing it to be reset completely if new data is uploaded.

library(shiny)
library(rhandsontable)

dataTabUI <- function(id, i, od, os) {
  ns <- NS(id)
  tagList(i,
          column(6, tableOutput(od)),
          column(6, rHandsontableOutput(os)))
}

dataTab <- function(input, output, session) {
  
}

csvFileInput <- function(id, label = "CSV file") {
  ns <- NS(id)
  tagList(
    fileInput(ns("file"), label)
  )
}

csvFile <- function(input, output, session) {
  userFile <- reactive({
    validate(need(input$file, message = FALSE))
    input$file
  })
  dataframe <- reactive({
    df <- read.csv(
      userFile()$datapath,
      header = TRUE
    )
  })
  dataframe
}

ui <- shinyUI(
  navbarPage(
    "My Application",
    tabPanel(
      "File Upload",
      dataTabUI("tab1", csvFileInput("datafile", "Upload CSV"),
                "data", "vars")
    )
  )
)

server <- function(input, output, session) {
  dataframe <- callModule(csvFile, "datafile")
  output$data <- renderTable({
    head(dataframe(), n = 10L)
  })
  output$vars <- renderRHandsontable({
    df <- dataframe()
    cnames <- colnames(df)
    ctypes <- vapply(cnames, function(cname) {
      class(df[[cname]])
    }, character(1))
    datavars <- data.frame(cnames = cnames, ctypes = ctypes,
                           treat = rep(TRUE, length(cnames)),
                           stringsAsFactors = FALSE)
    rhandsontable(datavars)
  })
}

shinyApp(ui, server)

[pomchip]

Hi

Look at https://github.com/jrowen/rhandsontable/issues/287

This is roughly similar except that the source of the table data is based upon selectInput choices. You should be able to modify the code to use a fileInput data source.

[radmuzom]

Thank you very much for the link.

I was able to modify my code based on the example. Posting it here for the community's benefit. The observe block at the end of the server function is for testing purposes only.

Any suggestions to improve the code further are always welcome.

library(shiny)
library(rhandsontable)

dataTabUI <- function(id, i, od, os) {
  ns <- NS(id)
  tagList(i,
          column(6, tableOutput(od)),
          column(6, rHandsontableOutput(os)))
}

dataTab <- function(input, output, session) {
  
}

csvFileInput <- function(id, label = "CSV file") {
  ns <- NS(id)
  tagList(
    fileInput(ns("file"), label)
  )
}

csvFile <- function(input, output, session) {
  userFile <- reactive({
    validate(need(input$file, message = FALSE))
    input$file
  })
  dataframe <- reactive({
    df <- read.csv(
      userFile()$datapath,
      header = TRUE
    )
  })
  dataframe
}

ui <- shinyUI(
  navbarPage(
    "My Application",
    tabPanel(
      "File Upload",
      dataTabUI("tab1", csvFileInput("datafile", "Upload CSV"),
                "data", "vars")
    )
  )
)

server <- function(input, output, session) {
  dataframe <- callModule(csvFile, "datafile")
  output$data <- renderTable({
    head(dataframe(), n = 10L)
  })
  
  dfvars <- reactive({
    df <- dataframe()
    cnames <- colnames(df)
    ivars <- input$vars
    if (length(ivars) > 0) {
      odf <- hot_to_r(ivars)
      ocnames <- odf$cnames
      if (!all(vapply(ocnames, function(x) {
        x %in% cnames
      }, logical(1)))) {
        ctypes <- vapply(cnames, function(cname) {
          class(df[[cname]])
        }, character(1))
        datavars <- data.frame(cnames = cnames, ctypes = ctypes,
                               treat = rep(TRUE, length(cnames)),
                               stringsAsFactors = FALSE)
      } else {
        datavars <- odf
      }
    } else {
      ctypes <- vapply(cnames, function(cname) {
        class(df[[cname]])
      }, character(1))
      datavars <- data.frame(cnames = cnames, ctypes = ctypes,
                             treat = rep(TRUE, length(cnames)),
                             stringsAsFactors = FALSE)
    }
    datavars
  })
  
  output$vars <- renderRHandsontable({
    rhandsontable(dfvars())
  })
  
  observe({
    print(dfvars())
  })
}

shinyApp(ui, server)