r - 在 Shiny 和 R 中动态添加行到 rhandsontable

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 种蛋白质的数据，其中均值和标准差可用。然后，用户还有 3 个报告中值和范围的地方。如果用户在选择中值/范围时取消选择均值/标准差，当前工作代码将丢失均值和标准差。就我现在所做的事情而言，这意味着我需要有效地执行 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 ) 上的回答，解决方案是使用 reactiveValues函数来存储数据帧。据我了解他们的解释，问题的发生是因为(与传统数据框不同)， react 数据框 DF()永远不会完成计算。

这是基于他们的答案的有效解决方案:

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
  values <- reactiveValues()

  observeEvent(input$update_table, {

    # determine which variables to show based on user input
    values$shown_variables <- 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'))
    })))

    # if a table does not already exist, this is our DF
    if (input$update_table == 1) {
      values$df <- make_DF(input$n_entries)
    } else { # otherwise,  append the new data frame to the old.
      tmp_data <- hot_to_r(input$input_data)
      values$df[,names(tmp_data)] <- tmp_data

      values$df <- bind_rows(values$df, make_DF(input$n_entries))
    }

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

}

shinyApp(ui = ui, server = server)