r - 根据闪亮应用程序的 rhandsontable 中其他单元格的修改更改单元格

Question

我正在尝试构建一个带有 rhandsontable 的闪亮应用程序。这个 rhandsontable 基于我在应用程序中创建的 datframe。

在应用程序中，我最初显示此数据框的第一行，共 3 列。当第一列的值被其下拉级别列表修改并按搜索时，其他 2 列将被修改。

我也想对第二列做同样的事情。此外，我最初希望仅显示前 2 列，当按下搜索按钮时将显示第三列，当然如果该行存在。

我试图复制我为第一列所做的（注释代码），但它不起作用。前 2 列应始终在下拉列表中显示其所有级别，但第三列仅在每次搜索后显示可用级别。

DF = data.frame(agency_postcode = factor(rep(c(12345,45678,24124,32525,32325),2)),
                           car_group=factor(rep(c("Microcar","City car","Supermini","Compact","SUV"),2)),
                           transmission=factor(rep(c("automatic","manual"),5)))
write.csv(DF,"C:/Users/User/Documents/Test//cars.csv", row.names = FALSE)

用户界面

library(shiny)
library(rhandsontable)


ui <- fluidPage(

  titlePanel("RHandsontable"),
  sidebarLayout(
    sidebarPanel(
     fileInput("file1", "Choose CSV File",
            accept = c(
              "text/csv",
              "text/comma-separated-values,text/plain",
              ".csv"),
      actionButton("sr", "Search")
    ),
    mainPanel(
      rHandsontableOutput("test")
    )
  )
)

服务器.r

server <- function(input, output) {

   # Assign value of 12345 as default to postcode for the default table rendering
   values <- reactiveValues(postcode = "12345"
                            #car_group = "Microcar"
                            ,tabledata = data.frame())


   # An observer which will check the value assigned to postcode variable and create the sample dataframe
   observeEvent(values$postcode,{
      inFile <- input$file1

  if (is.null(inFile))
     return(NULL)

  DF<- read.csv(inFile$datapath,stringsAsFactors = T)
  for(i in 1:ncol(DF)){
     DF[,i]<-as.factor(DF[,i])

  }
  DF
      DF2 = data.frame(agency_postcode = factor(rep(c(12345,45678,24124,32525,32325),2)),
                       car_group=factor(rep(c("Microcar","City car","Supermini","Compact","SUV"),2)),
                       transmission=factor(rep(c("automatic","manual"),5)))
      # Created dataframe is assigned to a reactive dataframe 'tabledata'
      values$tabledata <- DF2[ which(DF2$agency_postcode ==values$postcode
                                     #&DF2$car_group==values$car_group
                                     ), ]
      for(i in 2:ncol(values$tabledata)){
         values$tabledata[,i] <- factor(values$tabledata[,i])
      }
   })

   # Capture changes made in the first column of table and assign the value to the postcode reactive variable. This would then trigger the previous observer
   observeEvent(input$test$changes$changes,{
      col <- input$test$changes$changes[[1]][[2]]
      if(col==0){
         values$postcode <- input$test$changes$changes[[1]][[4]]
         #values$car_group<-input$test$changes$changes[[1]][[4]]
      }
   })

   # Use the reactive df 'tabledata' to render.
   output$test <- renderRHandsontable({input$sr
      isolate(rhandsontable(values$tabledata[1,], rowHeaders = NULL, width = 550, height = 300)%>%
         hot_col(colnames(values$tabledata))) 
   })


}

标签： rshinyrhandsontable

Answer 1

在您为检索第二列中选择的值而添加的代码中，我们需要更新一些内容。

if(col==0){
         values$postcode <- input$test$changes$changes[[1]][[4]]
         #values$car_group<-input$test$changes$changes[[1]][[4]]
      }

handsontable 的索引从 0 开始。因此，第一列为 0，第二列为 1，这意味着您无法在第一列的if条件内将值更新为car_group反应变量

根据我在此处提供的答案解决您当前的问题。通过更改一个单元格值来更新 rhandsontable

library(shiny)
library(rhandsontable)


ui <- fluidPage(

   titlePanel("RHandsontable"),
   sidebarLayout(
      sidebarPanel(),
      mainPanel(
         rHandsontableOutput("test")
      )
   )
)


server <- function(input, output) {

  # Assigning blank values to reactive variable as all the values need to be listed first
  values <- reactiveValues(postcode = "",cargroup = "",tabledata = data.frame())

  observeEvent(values$postcode,{
    DF2 = data.frame(agency_postcode = factor(rep(c(12345,45678,24124,32525,32325),2)),
                     car_group=factor(rep(c("Microcar","City car","Supermini","Compact","SUV"),2)),
                     transmission=factor(rep(c("automatic","manual"),5)))
    # When the user selects any value from the dropdown, filter the table and update the value of reactive df
    if(values$postcode!=""){
      values$tabledata <- DF2[ which(DF2$agency_postcode ==values$postcode), ]
    }else{
      # When the postcode value is blank, meaning the user hasn't selected any, the table 
      # will render without the third column
      values$tabledata <- DF2[,-3]
    }

  })

  observeEvent(values$cargroup,{
    DF2 = data.frame(agency_postcode = factor(rep(c(12345,45678,24124,32525,32325),2)),
                     car_group=factor(rep(c("Microcar","City car","Supermini","Compact","SUV"),2)),
                     transmission=factor(rep(c("automatic","manual"),5)))
    values$tabledata <- DF2
    # When the user selects any value from the dropdown, filter the table and update the value of reactive df
    if(values$cargroup!=""){
      values$tabledata <- DF2[ which(DF2$car_group ==values$cargroup), ]
    }else{
      # When the cargroup value is blank, meaning the user hasn't selected any, the table 
      # will render without the third column
      values$tabledata <- DF2[,-3]
    }

  })

  # Observer for changes made to the hot
  observeEvent(input$test$changes$changes,{
    col <- input$test$changes$changes[[1]][[2]]
    # Changes made in first column
    if(col==0){
      values$postcode <- input$test$changes$changes[[1]][[4]]
    }
    # Changes made in second column
    if(col==1){
      values$cargroup <- input$test$changes$changes[[1]][[4]]
    }
  })

  # Render the hot object
  output$test <- renderRHandsontable({
    rhandsontable(values$tabledata[1,], rowHeaders = NULL, width = 550, height = 300)%>%
      hot_col(colnames(values$tabledata)) 
  })


}

shinyApp(ui = ui, server = server)

检查这是否适合您的需求。然后，您可以根据搜索按钮更新观察者部分，而不是对用户所做的更改做出反应。