动态地将行添加到有光泽的Rhandsontable和R

Question

我正在尝试创建一个应用程序，它最终需要在对数刻度上的蛋白质浓度的平均值和sd。由于对数标度值几乎从未报告，我发现参考文献允许我使用常用​​数据（平均值+标准差，中位数+范围，中位数+ IQR，5点摘要等）来近似对数标度。 ）。

用户将使用当前使用rhandsontable实现的表输入数据，直到我添加了足够的错误处理以容纳CSV文件，并且我想限制此表中显示的列，以便它不会压倒性的。我已经完成了这一点，从以下可重现的例子中可以看出。

library(shiny)
library(rhandsontable)
library(tidyverse) 

make_DF <- function(n) {
  DF <- data_frame(
    entry = 1:n,
    protein = NA_character_,
    MW = NA_real_,
    n = NA_integer_,
    mean = NA_real_,
    sd = NA_real_,
    se = NA_real_,
    min = NA_real_,
    q1 = NA_real_,
    median = NA_real_,
    q3 = NA_real_,
    max = NA_real_,
    log_mean = NA_real_,
    log_sd = NA_real_,
    log_min = NA_real_,
    log_q1 = NA_real_,
    log_median = NA_real_,
    log_q3 = NA_real_,
    log_max = NA_real_,
    units = factor("ng/mL", levels  = c("pg/mL", "ng/mL", 'mcg/mL', 'mg/mL', 'g/mL')
    )
  )
  DF[-1]
}

ui <- fluidPage(
  tabPanel("Input", 
  column(4,
    wellPanel(
      checkboxGroupInput("data_format",
        "The data consists of",
        c("Mean and standard deviation" = "mean_sd",
          "Mean and standard error" = "mean_se",
          "Mean and standard deviation (log scale)" = "log_mean_sd",
          "Mean and standard error (log scale)" = "log_mean_se",
          "Median, min, and max" =  "median_range",
          "Median, Q1, and Q3" = 'median_iqr',
          "Five point summary" = 'five_point'
          # "Other combination" = 'other')
        )
      ),
      # p("Please note that selecting 'other' may result in invalid combinations."),
      # titlePanel("Number of Entries"),
      numericInput("n_entries",
        "Number of Concentrations to estimate:",
        value = 1,
        min = 1),
      actionButton("update_table", "Update Table")
    )
  ),
  column(8,
    rHandsontableOutput("input_data") )
),
  tabPanel("Output",
    column(12,
      tableOutput("test_output")
    )
  )
)

server <- function(input, output) {
  # create or update the data frame by adding some rows
  DF <- eventReactive(input$update_table, {
    DF_new <- make_DF(input$n_entries)

    # if a table does not already exist, this is our DF
    if (input$update_table == 1) {
      return(DF_new)
    } else { # otherwise, we will append the new data frame to the old.

      tmp_df <- hot_to_r(input$input_data)
      return(rbind(tmp_df, DF_new))
    }
  })

  # determine which variables to show based on user input
  shown_variables <- eventReactive(input$update_table, {
    unique(unlist(lapply(input$data_format, function(x) {
      switch(x,
        "mean_sd" = c('mean', 'sd'),
        "mean_se" = c('mean', 'se'),
        'log_mean_sd' = c("log_mean", 'log_sd'),
        "log_mean_se" = c('log_mean', 'log_se'),
        "median_range" = c('median','min', 'max'),
        'median_IQR' = c("median", 'q1','q3'),
        "five_point" = c('median', 'min', 'q1', 'q3', 'max'))
    })))
  })

  # # finally, set up table for data entry
  observeEvent(input$update_table, {
    DF_shown <- DF()[c('protein', 'MW', 'n', shown_variables(), "units")]
    output$test_output <- renderTable(DF())
    output$input_data <- renderRHandsontable({rhandsontable(DF_shown)})
  })
}

shinyApp(ui = ui, server = server)

我还希望能够动态更改显示哪些字段而不会丢失数据。例如，假设用户输入5种蛋白质的数据，其中均值和sd可用。然后，用户还有3个报告中位数和范围的地方。如果用户在选择中位数/范围时取消选择mean / sd，则当前工作代码将失去平均值和标准差。在我现在所做的事情中，这意味着我需要使用rbind和新请求的行有效地执行DF()。这给了我错误：

# infinite loop error
server <- function(input, output) {
  # create or update the data frame by adding some rows
  DF <- eventReactive(input$update_table, {
    DF_new <- make_DF(input$n_entries)

    # if a table does not already exist, this is our DF
    if (input$update_table == 1) {
      return(DF_new)
    } else { # otherwise, we will append the new data frame to the old.

      tmp_df <- hot_to_r(input$input_data)
      return(rbind(DF(), DF_new))
    }
  })

  # determine which variables to show based on user input
  shown_variables <- eventReactive(input$update_table, {
    unique(unlist(lapply(input$data_format, function(x) {
      switch(x,
        "mean_sd" = c('mean', 'sd'),
        "mean_se" = c('mean', 'se'),
        'log_mean_sd' = c("log_mean", 'log_sd'),
        "log_mean_se" = c('log_mean', 'log_se'),
        "median_range" = c('median','min', 'max'),
        'median_IQR' = c("median", 'q1','q3'),
        "five_point" = c('median', 'min', 'q1', 'q3', 'max'))
    })))
  })

  # # finally, set up table for data entry
  observeEvent(input$update_table, {
    DF_shown <- DF()[c('protein', 'MW', 'n', shown_variables(), "units")]
    output$test_output <- renderTable(DF())
    output$input_data <- renderRHandsontable({rhandsontable(DF_shown)})
  })
}

我见过其他有类似问题的人（例如Append a reactive data frame in shiny R），但似乎还没有接受答案。 关于解决方案或解决方案的任何想法？我打开任何允许用户限制哪些字段可见的想法，但保留所有输入的数据是否实际显示。

Answer 1

感谢Joe Cheng和Hao Wu以及他们在github（https://github.com/rstudio/shiny/issues/2083）上的答案，解决方案是使用class函数来存储数据框。据我了解他们的解释，问题正在发生，因为（与传统数据框架不同），反应数据框reactiveValues永远不会完成计算。

根据他们的答案，这是一个有效的解决方案：

DF()