Ability to pull the current state of rhandsontable

[brent-halen]

There needs to be an ability to pull the current state (sort, row-order, contents, etc) of an RHandsonTable object. If I want to write an app that filters values from a base source and generates three separate tables (filtered, removed, and combined) based from the original data source, I can't save the changes back to the source data.

library(shiny)
library(dplyr)
library(rhandsontable)

LinearizeNestedList <- function(NList, LinearizeDataFrames=FALSE,
                                NameSep="/", ForceNames=FALSE) {
  # LinearizeNestedList:
  #
  # https://sites.google.com/site/akhilsbehl/geekspace/
  #         articles/r/linearize_nested_lists_in_r
  #
  # Akhil S Bhel
  # 
  # Implements a recursive algorithm to linearize nested lists upto any
  # arbitrary level of nesting (limited by R's allowance for recursion-depth).
  # By linearization, it is meant to bring all list branches emanating from
  # any nth-nested trunk upto the top-level trunk s.t. the return value is a
  # simple non-nested list having all branches emanating from this top-level
  # branch.
  #
  # Since dataframes are essentially lists a boolean option is provided to
  # switch on/off the linearization of dataframes. This has been found
  # desirable in the author's experience.
  #
  # Also, one'd typically want to preserve names in the lists in a way as to
  # clearly denote the association of any list element to it's nth-level
  # history. As such we provide a clean and simple method of preserving names
  # information of list elements. The names at any level of nesting are
  # appended to the names of all preceding trunks using the `NameSep` option
  # string as the seperator. The default `/` has been chosen to mimic the unix
  # tradition of filesystem hierarchies. The default behavior works with
  # existing names at any n-th level trunk, if found; otherwise, coerces simple
  # numeric names corresponding to the position of a list element on the
  # nth-trunk. Note, however, that this naming pattern does not ensure unique
  # names for all elements in the resulting list. If the nested lists had
  # non-unique names in a trunk the same would be reflected in the final list.
  # Also, note that the function does not at all handle cases where `some`
  # names are missing and some are not.
  #
  # Clearly, preserving the n-level hierarchy of branches in the element names
  # may lead to names that are too long. Often, only the depth of a list
  # element may only be important. To deal with this possibility a boolean
  # option called `ForceNames` has been provided. ForceNames shall drop all
  # original names in the lists and coerce simple numeric names which simply
  # indicate the position of an element at the nth-level trunk as well as all
  # preceding trunk numbers.
  #
  # Returns:
  # LinearList: Named list.
  #
  # Sanity checks:
  #
  stopifnot(is.character(NameSep), length(NameSep) == 1)
  stopifnot(is.logical(LinearizeDataFrames), length(LinearizeDataFrames) == 1)
  stopifnot(is.logical(ForceNames), length(ForceNames) == 1)
  if (! is.list(NList)) return(NList)
  #
  # If no names on the top-level list coerce names. Recursion shall handle
  # naming at all levels.
  #
  if (is.null(names(NList)) | ForceNames == TRUE)
    names(NList) <- as.character(1:length(NList))
  #
  # If simply a dataframe deal promptly.
  #
  if (is.data.frame(NList) & LinearizeDataFrames == FALSE)
    return(NList)
  if (is.data.frame(NList) & LinearizeDataFrames == TRUE)
    return(as.list(NList))
  #
  # Book-keeping code to employ a while loop.
  #
  A <- 1
  B <- length(NList)
  #
  # We use a while loop to deal with the fact that the length of the nested
  # list grows dynamically in the process of linearization.
  #
  while (A <= B) {
    Element <- NList[[A]]
    EName <- names(NList)[A]
    if (is.list(Element)) {
      #
      # Before and After to keep track of the status of the top-level trunk
      # below and above the current element.
      #
      if (A == 1) {
        Before <- NULL
      } else {
        Before <- NList[1:(A - 1)]
      }
      if (A == B) {
        After <- NULL
      } else {
        After <- NList[(A + 1):B]
      }
      #
      # Treat dataframes specially.
      #
      if (is.data.frame(Element)) {
        if (LinearizeDataFrames == TRUE) {
          #
          # `Jump` takes care of how much the list shall grow in this step.
          #
          Jump <- length(Element)
          NList[[A]] <- NULL
          #
          # Generate or coerce names as need be.
          #
          if (is.null(names(Element)) | ForceNames == TRUE)
            names(Element) <- as.character(1:length(Element))
          #
          # Just throw back as list since dataframes have no nesting.
          #
          Element <- as.list(Element)
          #
          # Update names
          #
          names(Element) <- paste(EName, names(Element), sep=NameSep)
          #
          # Plug the branch back into the top-level trunk.
          #
          NList <- c(Before, Element, After)
        }
        Jump <- 1
      } else {
        NList[[A]] <- NULL
        #
        # Go recursive! :)
        #
        if (is.null(names(Element)) | ForceNames == TRUE)
          names(Element) <- as.character(1:length(Element))
        Element <- LinearizeNestedList(Element, LinearizeDataFrames,
                                       NameSep, ForceNames)
        names(Element) <- paste(EName, names(Element), sep=NameSep)
        Jump <- length(Element)
        NList <- c(Before, Element, After)
      }
    } else {
      Jump <- 1
    }
    #
    # Update book-keeping variables.
    #
    A <- A + Jump
    B <- length(NList)
  }
  return(NList)
}

first <- paste("This_",letters,sep="")

second <- paste("This_1",letters,sep="")
third <- paste("This_2", letters,sep="")
fourth <- paste("This_3", letters, sep="")
index <- c(first, second, third, fourth)[1:100]
frame <- as.data.frame(matrix(data=rnorm(10000), nrow=100, ncol=100, byrow=TRUE))
colnames(frame) <- index
frame <- cbind.data.frame(data.frame(Index = c(101:200)), frame)

ui <- fluidPage(
  textOutput("values"), 
  rHandsontableOutput("hot"),
  rHandsontableOutput("hot1"),
  rHandsontableOutput("hot2")

)

# Define server logic required to draw a histogram
server <- function(input, output) {
   data <- reactiveValues(
     base = frame,
     values = NA
   )
   output$hot <- renderRHandsontable({
     data <- data$base
     data <- data[which(data[,2] >= 0),]
     rhandsontable(data, readOnly = FALSE, selectCallback = TRUE)%>%
       hot_cols(columnSorting=TRUE)
   })
   output$hot1 <- renderRHandsontable({
     data <- data$base
     data <- data[which(data[,2] <= 0),]
     rhandsontable(data, readOnly = FALSE, selectCallback = TRUE)%>%
       hot_cols(columnSorting=TRUE)
   })
   output$hot2 <- renderRHandsontable({
     data <- data$base
     data$Filtered <- (data[,2] >= 0)
     rhandsontable(data, readOnly = FALSE, selectCallback = TRUE) %>%
       hot_cols(columnSorting=TRUE)
   })
   output$values <- renderText({data$values})

   observe({if(!is.null(input$hot$changes$changes)){
     table <- hot_to_r(input$hot)
     print("CHANGE DETECTED")
     changes_list <- LinearizeNestedList(input$hot$changes$changes)
     row <- ((changes_list[[1]]) + 1)
     column <- (changes_list[[2]] + 1)
     original_contents <- (changes_list[[3]])
     new_contents <- (changes_list[[4]])
     col_target1 <- which(colnames(table) == 'Index')
     Index2 <- input$hot$data[[row]][[col_target1]]
     Index3 <- input$hot$data[[row]][[column]]
     print(row)
     print(column)
     print(original_contents)
     print(new_contents)
     print("")
     print("First Version of Index & Target")
     Index1 <- hot_to_r(input$hot)$Index[row]
     target1 <- colnames(hot_to_r(input$hot))[column]
     print(Index1)
     print(target1)
     print("")
     print("Version 2")
     print(Index2)
     print("")
     print("Version3")
     print(Index3)
     print("")
     print("")

     print(input$hot_select$select$r[[1]])
     print(input$hot_select$select$c[[1]])
     print(data$base$Index[input$hot_select$select$r[[1]]])}
     tryCatch({data$values <- paste(c(row,column,original_contents,new_contents,Index1,target1,Index2,Index3),sep = "  ")}, error=function(e){
       data$values = NA
     })
   })
  }

# Run the application 
shinyApp(ui = ui, server = server)

Here's some example code. Run the app, sort one of the columns, and start making changes. I can't seem to find a way to match the value in the Index column with the values provided by input$hot$changes or input$hot_select.

[jrowen]

You might be able to do this via some functionality is htmlwidgets or shinyjs.