如何在 Shiny 中 selectInput 后​​自动重新渲染 rhandsontable

Question

我正在开发一个 Shiny 应用程序，用户可以在其中将一些数据输入到不同的数据集中，然后用于计算数据集中的其他变量。数据集的选择由 selectInput 决定。 我选择了 rHandsontable，因为它成功地模仿了熟悉的电子表格输入。我调整了用于计算来自this answer 的列的解决方案，并且效果很好。除了一件小事：在选择了不同的数据集之后，rhandsontable 不会重新渲染，直到用户与之交互。我知道这是应该发生的，但就我而言，我们需要重新渲染。 我尝试了观察、观察事件和事件反应的不同组合，但没有任何效果。最接近我的是包含选择更改的 reactiveVal 指标，它至少表明应该使用新数据。 这是我得到的 MRE。

library(shiny)
library(rhandsontable)

data <- list (
  table1 = data.frame( beginning = as.numeric(rep(8, 4)),
                ending = as.numeric(rep(15, 4))),

table2 = data.frame( beginning = as.numeric(rep(9, 4)),
                ending = as.numeric(rep(17, 4)))
)

data[["table1"]]$hours <- data[["table1"]]$ending - data[["table1"]]$beginning
data[["table2"]]$hours <- data[["table2"]]$ending - data[["table2"]]$beginning

############################# UI #############################

ui = shinyUI(fluidPage(
  selectInput("tab", "Chose table: ", choices = list("table1", "table2")),
  fluidRow(wellPanel(
    column(6,
           rHandsontableOutput("hot"),
           actionButton(inputId="enter",label="Save")
    ),

    column(6,
           textOutput("title"),
           tableOutput("tabela")
    )))
))

########################## SEREVER ###########################

server=function(input,output, session){

  tab_change <- reactiveVal(FALSE)


   # rw <- reactivePoll(1000, session, file_name, read.csv2)
   react_week <- reactive({
     df <- data[[input$tab]]
     })

  output$title <- renderText(input$tab)

  output$tabela <- renderTable(react_week())

  observeEvent(input$tab,
               {tab_change(TRUE)
               })


  # Calculation of columns
  for_week <- reactive({

    datacopy <- NULL

    #For initial data upltabd
    if(isolate(tab_change()) || is.null(input$hot)) {
      datacopy <- react_week()
    }
    else {
      datacopy <- hot_to_r(input$hot)
    }

    #If there is change in data
    if(!is.null(input$hot$changes$changes)){

      col.no <- as.numeric(unlist(input$hot$changes$changes)[2])
      new.val <- unlist(input$hot$changes$changes)[4]

      #If the changed value is prihod or odhod
      if(col.no == 0 || col.no == 1){
        datacopy[, 3] <- as.numeric(datacopy[, 2]) - as.numeric(datacopy[, 1])
      }

    }

    tab_change(FALSE)
    datacopy

  })

  output$hot <- renderRHandsontable(
    rhandsontable(for_week())
  )

  observeEvent(input$enter, {
    data[[input$tab]] <<- hot_to_r(input$hot)
    output$tabela <- renderTable( data[[input$tab]])
  })

}

shinyApp(ui = ui, server = server)

我是 Shiny 的新手，所以我可能会错过明显的内容，但是有没有办法在选择更改后立即重新渲染 rhandsontable，而不是使用我害怕的一些低级函数，例如 sendInputMessage？ 如果没有，我在哪里可以找到一些关于如何构建这样的消息来为我工作的说明？

Answer 1

使用eventReactive 并通过input$tab 和input$hot 而不是reactive 触发您的for_week 反应对象：

library(shiny)
library(rhandsontable)

data <- list (
  table1 = data.frame( beginning = as.numeric(rep(8, 4)),
                       ending = as.numeric(rep(15, 4))),

  table2 = data.frame( beginning = as.numeric(rep(9, 4)),
                       ending = as.numeric(rep(17, 4)))
)

data[["table1"]]$hours <- data[["table1"]]$ending - data[["table1"]]$beginning
data[["table2"]]$hours <- data[["table2"]]$ending - data[["table2"]]$beginning

############################# UI #############################

ui = shinyUI(fluidPage(
  selectInput("tab", "Chose table: ", choices = list("table1", "table2")),
  fluidRow(wellPanel(
    column(6,
           rHandsontableOutput("hot"),
           actionButton(inputId="enter",label="Save")
    ),

    column(6,
           textOutput("title"),
           tableOutput("tabela")
    )))
))

########################## SEREVER ###########################

server=function(input,output, session){

  tab_change <- reactiveVal(FALSE)


  # rw <- reactivePoll(1000, session, file_name, read.csv2)
  react_week <- reactive({
    df <- data[[input$tab]]
  })

  output$title <- renderText(input$tab)

  output$tabela <- renderTable(react_week())

  observeEvent(input$tab,
               {tab_change(TRUE)
               })


  # Calculation of columns
  # ----------------------------Modified here----------------------------
  # for_week <- reactive({
  for_week <- eventReactive(c(input$tab, input$hot), {
  # ---------------------------------------------------------------------

    datacopy <- NULL

    #For initial data upltabd
    if(isolate(tab_change()) || is.null(input$hot)) {
      datacopy <- react_week()
    }
    else {
      datacopy <- hot_to_r(input$hot)
    }

    #If there is change in data
    if(!is.null(input$hot$changes$changes)){

      col.no <- as.numeric(unlist(input$hot$changes$changes)[2])
      new.val <- unlist(input$hot$changes$changes)[4]

      #If the changed value is prihod or odhod
      if(col.no == 0 || col.no == 1){
        datacopy[, 3] <- as.numeric(datacopy[, 2]) - as.numeric(datacopy[, 1])
      }

    }

    tab_change(FALSE)
    datacopy

  })

  output$hot <- renderRHandsontable(
    rhandsontable(for_week())
  )

  observeEvent(input$enter, {
    data[[input$tab]] <<- hot_to_r(input$hot)
    output$tabela <- renderTable( data[[input$tab]])
  })

}

shinyApp(ui = ui, server = server)