Question

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

Answer 1

您可以使用selectCallback = TRUE获取所选的行，列，范围和单元格值以及已编辑的单元格。您可以通过双击来编辑单元格，然后按＆＃34;返回＆＃34;接受更改。或者＆＃34;输入＆＃34;。

最小例子：

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)

Answer 2

虽然rhandsontable是一个非常好的实施方式（信用转到@jrowen），但目前它不包括getSelected（）。

用户更改任何单元格（包括选择/取消选中复选框）的事件由闪亮跟踪。这样就可以使用复选框让用户选择（或取消选择）一行或多行。

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

下面的代码片段可能会让您了解如何管理它。

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)

获取选定的Rhandsontable行

2 个答案: