4

我正在尝试创建一个最终需要对数刻度上蛋白质浓度的平均值和标准差的应用程序。由于几乎从未报告过对数刻度值,因此我找到了参考资料,这些参考资料允许我使用常用​​数据(均值 + 标准差、中值 + 范围、中值 + 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 个报告中值和范围的位置。如果用户在选择中值/范围时取消选择均值/标准差,则当前工作代码将丢失均值和标准差。就我现在所做的而言,这意味着我需要有效地执行rbindusingDF()和新请求的行。这给了我错误:

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

我见过其他有类似问题的人(例如在闪亮的 R 中附加一个反应性数据框),但似乎还没有一个公认的答案。关于解决方案或变通办法的任何想法?我愿意接受任何允许用户限制哪些字段可见的想法,但无论是否实际显示,都保留所有输入的数据。

4

1 回答 1

2

感谢 Joe Cheng 和 Hao Wu 以及他们在 github ( https://github.com/rstudio/shiny/issues/2083 ) 上的回答,解决方案是使用reactiveValues函数来存储数据帧。据我了解他们的解释,问题的发生是因为(与传统数据帧不同),反应数据帧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)
于 2018-06-04T15:54:27.877 回答