dynamically add rows to rhandsontable in shiny and R

问题

I'm trying to create an app which ultimately needs the mean and sd of a protein's concentration on the log scale. Since the log-scale values are almost never reported, I've found references which allow me to approximate log-scale using commonly available data (the mean + sd, median + range, median + IQR, 5 point summary, etc.).

Users will enter the data using a table currently implemented using rhandsontable until I've added enough error handling to accommodate CSV files, and I want to limit the columns displayed in this table so that it's not overwhelming. This I have done, as can be seen from the following reproducible example.

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)

I also want to be able to dynamically change which fields are displayed without losing data. For example, suppose the user enters data for 5 proteins where the mean and sd are available. Then, the user has 3 more where the median and range are reported. If the user deselects mean/sd when median/range are selected, the current working code will lose the mean and standard deviation. In the context of what I'm doing now, that means I need to effectively perform an rbind using DF() and the newly requested rows. This is giving me errors:

# 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)})
  })
}

I've seen other individuals with similar issues (e.g. Append a reactive data frame in shiny R), but there doesn't appear to be an accepted answer yet. Any ideas on solutions or work-arounds? I'm open to any ideas that allow users to limit which fields are visible, but keep all entered data whether or not it is actually displayed.

回答1:

Thanks to Joe Cheng and Hao Wu and their answers on github (https://github.com/rstudio/shiny/issues/2083), the solution is to use the reactiveValues function to store the data frame. As I understand their explanation, the problem is occurring because (unlike traditional data frames), the reactive data frame DF() never finishes calculating.

Here's a working solution to the based on their answers:

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)

来源：https://stackoverflow.com/questions/50651618/dynamically-add-rows-to-rhandsontable-in-shiny-and-r