Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Get selected rows of Rhandsontable

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!

like image 540
Laia Cabré Vandellós Avatar asked Jun 09 '15 13:06

Laia Cabré Vandellós


2 Answers

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)
like image 149
Jorge Sepulveda Avatar answered Sep 30 '22 01:09

Jorge Sepulveda


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)
like image 44
Enzo Avatar answered Sep 30 '22 02:09

Enzo