column - Get selected rows of Rhandsontable




width add (5)

Convert data from rhandsontable object into dataframe in Shiny

Look into the shinysky package, as it uses Handsontable, which has hot.to.df function that would allow you to convert your datatable into dataframe. Below is a minimal example showing what I mean

rm(list = ls())
library(shiny)
library(shinysky)

server <- shinyServer(function(input, output, session) {

  # Initiate your table
  previous <- reactive({head(mtcars)})

  Trigger_orders <- reactive({
    if(is.null(input$hotable1)){return(previous())}
    else if(!identical(previous(),input$hotable1)){
      # hot.to.df function will convert your updated table into the dataframe
      as.data.frame(hot.to.df(input$hotable1))
    }
  })
  output$hotable1 <- renderHotable({Trigger_orders()}, readOnly = F)
  # You can see the changes you made
  output$tbl = DT::renderDataTable(Trigger_orders())
})

ui <- basicPage(mainPanel(column(6,hotable("hotable1")),column(6,DT::dataTableOutput('tbl'))))
shinyApp(ui, server)

I am using rhandsontable in a Shiny App and I would like to know how to use the getSelected() method of Handsontable in this case, as I intend to apply changes on the data.frame. thank you!


You can obtain the selected row, column, range, and cell values, as well as the edited cells using selectCallback=TRUE. You can edit a cell by double-clicking on it, and accept the changes by pressing "return" or "enter".

Minimal example:

library(shiny)
library(rhandsontable)
ui=fluidPage(
  rHandsontableOutput('table'),
  verbatimTextOutput('selected')
)

server=function(input,output,session)({
  df=data.frame(N=c(1:10),L=LETTERS[1:10],M=LETTERS[11:20])
  output$table=renderRHandsontable(
    rhandsontable(df,selectCallback = TRUE,readOnly = FALSE)
  )
  output$selected=renderPrint({
    cat('Selected Row:',input$table_select$select$r)
    cat('\nSelected Column:',input$table_select$select$c)
    cat('\nSelected Cell Value:',
        input$table_select$data[[
          input$table_select$select$r]][[input$table_select$select$c]])
    cat('\nSelected Range: R',input$table_select$select$r,
        'C',input$table_select$select$c,':R',input$table_select$select$r2,
        'C',input$table_select$select$c2,sep="")
    cat('\nChanged Cell Row Column:',input$table$changes$changes[[1]][[1]],
        input$table$changes$changes[[1]][[2]])    
    cat('\nChanged Cell Old Value:',input$table$changes$changes[[1]][[3]])
    cat('\nChanged Cell New Value:',input$table$changes$changes[[1]][[4]])
  })
}) # end server
shinyApp(ui = ui, server = server)

While rhandsontable is a real good implementation of handsontable (credit goes to @jrowen), currently it does not include getSelected().

The event of a user altering any cell (including selecting / deselecting a checkbox) is tracked by shiny. This gives the opportunity to use checkboxes to let the user to select (or de-select) one or more rows.

Unfortunately the logic to understand what has been selected needs to be developed on the server side by your code.

The snippet of code below may give you some idea on how to manage it.

options(warn=-1)
library(rhandsontable)
library(shiny)

options(warn=-1)
quantity <- id <- 1:20
label <- paste0("lab","-",quantity)
pick <- FALSE
iris_ <- data.frame(id=id,pick=pick, quantity=quantity,label=label,iris[1:20,] ,stringsAsFactors = FALSE)
mtcars_ <- data.frame(id=id,pick=pick, quantity=quantity,label=label,mtcars[1:20,] ,stringsAsFactors = FALSE)
iris_$Species <- NULL #  i.e.  no factors
#---------------------------
ui <- fluidPage(
    fluidRow(
        column(6,rHandsontableOutput('demTb')),
        column(3,uiOutput("demSli")),
    column(3, radioButtons("inButtn", label=NULL, choices= c("iris","mtcars"), selected = "iris", inline = TRUE))
        )
    )

server <- function(session, input, output) {

selData <- ""


output$demSli <- renderUI({

if(is.null(input$demTb) ) return()

isolate({
df_ <- hot_to_r(input$demTb)
index <- which(df_$pick==T)
if(length(index)==0) return()
labs <- iris_$label[index] 
pages <- "test"
iter <- length(labs)
buttn <- 1
valLabs <- sapply(1:iter, function(i) {
if(is.null(input[[paste0(pages,"d",labs[i],buttn)]] )) {
          0
} else {  as.numeric(input[[paste0(pages,"d",labs[i],buttn)]])  }
}) 
#
toRender <- lapply(1:iter, function(i) {
  sliderInput(inputId = paste0(pages,"d",labs[i],buttn),
              label =  h6(paste0(labs[i],"")),
              min = -100,
              max = 100,
              step = 1,
              value = valLabs[i],
              post="%",
              ticks = FALSE, animate = FALSE)
              })
})
      return(toRender)

})
#--------------------
rds <- reactive({

  # if( is.null(input$demTb) ) {
  if( input$inButtn == "iris") { 
      if(selData == "" | selData == "mtcars") {
         selData <<- "iris"

        return(iris_) # first time for iris
      }
  } else {
      if(selData == "iris" ) {
         selData <<- "mtcars"

        return(mtcars_) # first time for mtcars
      }
    }

df_ <- hot_to_r(input$demTb)
isolate({

index <- which(df_$pick==T) 
if(length(index)==0) return(df_)
labs <- iris_$label[index] 
pages <- "test"
iter <- length(labs)
buttn <- 1
}) # end isolate
valLabs <- sapply(1:iter, function(i) {
    if(is.null(input[[paste0(pages,"d",labs[i],buttn)]] )) {
      0
    } else {  
      as.numeric(input[[paste0(pages,"d",labs[i],buttn)]])/100  
    }
  })

  dft_ <- data.frame(label=labs, multi=valLabs, stringsAsFactors = FALSE)
  dft_ <- merge(iris_,dft_,by="label", all.x=T)

  dft_$quantity <- sapply(1:length(dft_$quantity), function(z) {
    if( is.na( dft_$multi[z]) ) { 
    dft_$quantity[z]
  } else { iris_$quantity[z]*(1 + dft_$multi[z]) }
})
dft_[with(dft_,order(as.numeric(id))),]
df_[with(df_,order(as.numeric(id))),]

df_$quantity <- df_$quantity
  return(df_)
  }) 


output$demTb  <-  renderRHandsontable({


if(is.null(rds() )) return()

df_ <- rds() 

df_ <- df_[with(df_,order(as.numeric(id))),]

rhandsontable(df_, readOnly = FALSE, rowHeaders= NULL, useTypes= TRUE) %>%
  hot_table(highlightCol = TRUE, highlightRow = TRUE) 


})

}


shinyApp(ui, server)

Well, I have found the way to convert rhandsontable object into dataframe in R.

It seems to be very easy with the function 'hot_to_r' but the overall function description is poor.

So look up some examples and explanations outside the package description (pdf) on CRAN. In my case I have used black-box testing.

Here is my case:

test_case <- hot_to_r(input$all_updates)

The variable 'test_case' is a dataframe.


On the side note, here is how the various plyr functions correspond to the base *apply functions (from the intro to plyr document from the plyr webpage http://had.co.nz/plyr/)

Base function   Input   Output   plyr function 
---------------------------------------
aggregate        d       d       ddply + colwise 
apply            a       a/l     aaply / alply 
by               d       l       dlply 
lapply           l       l       llply  
mapply           a       a/l     maply / mlply 
replicate        r       a/l     raply / rlply 
sapply           l       a       laply 

One of the goals of plyr is to provide consistent naming conventions for each of the functions, encoding the input and output data types in the function name. It also provides consistency in output, in that output from dlply() is easily passable to ldply() to produce useful output, etc.

Conceptually, learning plyr is no more difficult than understanding the base *apply functions.

plyr and reshape functions have replaced almost all of these functions in my every day use. But, also from the Intro to Plyr document:

Related functions tapply and sweep have no corresponding function in plyr, and remain useful. merge is useful for combining summaries with the original data.