获取 Rhandsontable 的选定行

Posted 2023-03-22

【中文标题】获取 Rhandsontable 的选定行

【英文标题】：Get selected rows of Rhandsontable

【发布时间】：2015-08-24 08:40:30

【问题描述】：

我在 Shiny App 中使用 rhandsontable，我想知道在这种情况下如何使用 Handsontable 的 getSelected() 方法，因为我打算在 data.frame 上应用更改。 谢谢！

【参考方案1】：

您可以使用 selectCallback=TRUE 获取选定的行、列、范围和单元格的值，以及编辑的单元格。您可以通过双击一个单元格来编辑它，然后按“return”或“enter”接受更改。

小例子：

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)

【讨论】：

好的，谢谢。备注一点：单元格值的两个“+1”应该去掉。

这太好了，非常感谢！我必须添加一个验证来检查列的总和是否超过 100（并设置可以动态编辑的单元格的最大值）。使用反应函数分配最大值非常好。

input$table_select$select$rAll 将返回所有选定的行。而cAll 将返回所有选定的列。

有没有办法取消选择，所以一旦再次单击该行或在表格外单击时，“选定行：”再次变为 NA？ @世嘉

【参考方案2】：

虽然 rhandsontable 是 handsontable 的一个非常好的实现（感谢 @jrowen），但目前它不包括 getSelected()。

闪亮跟踪用户更改任何单元格（包括选择/取消选择复选框）的事件。这提供了使用复选框让用户选择（或取消选择）一行或多行的机会。

不幸的是，理解所选择内容的逻辑需要由您的代码在服务器端开发。

下面的sn-p代码可能会给你一些管理思路。

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)