在 shiny 和 R 中动态地将行添加到 rhandsontable
dynamically add rows to rhandsontable in shiny and R
我正在尝试创建一个最终需要蛋白质浓度的均值和标准差的应用程序对数刻度。由于几乎从未报告过对数刻度值，我找到了参考资料，这些参考资料允许我使用常用数据（均值 + 标准差、中位数 + 范围、中位数 + IQR、5 点总结等）来近似对数刻度。
用户将使用目前使用 rhandsontable 实现的 table 输入数据，直到我添加了足够的错误处理来容纳 CSV 文件，并且我想限制此 table 这样就不会让人不知所措。从以下可重现的示例中可以看出，我已经做到了这一点。
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 个报告中值和范围的位置。如果用户在选择 median/range 时取消选择 mean/sd，则当前工作代码将丢失均值和标准差。在我现在所做的上下文中，这意味着我需要使用 DF() 和新请求的行有效地执行 rbind。这给我错误：
# 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），但似乎还没有公认的答案。
关于解决方案或解决方法的任何想法？我愿意接受任何允许用户限制哪些字段可见的想法，但保留所有输入的数据，无论它是否实际显示。
感谢 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)
我正在尝试创建一个最终需要蛋白质浓度的均值和标准差的应用程序对数刻度。由于几乎从未报告过对数刻度值，我找到了参考资料，这些参考资料允许我使用常用数据（均值 + 标准差、中位数 + 范围、中位数 + IQR、5 点总结等）来近似对数刻度。
用户将使用目前使用 rhandsontable 实现的 table 输入数据，直到我添加了足够的错误处理来容纳 CSV 文件，并且我想限制此 table 这样就不会让人不知所措。从以下可重现的示例中可以看出，我已经做到了这一点。
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 个报告中值和范围的位置。如果用户在选择 median/range 时取消选择 mean/sd，则当前工作代码将丢失均值和标准差。在我现在所做的上下文中，这意味着我需要使用 DF() 和新请求的行有效地执行 rbind。这给我错误：
# 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），但似乎还没有公认的答案。 关于解决方案或解决方法的任何想法？我愿意接受任何允许用户限制哪些字段可见的想法，但保留所有输入的数据，无论它是否实际显示。
感谢 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)