Я пытаюсь создать приложение, которое в конечном итоге нуждается в среднем и сд. Концентрации белка в логарифмическом масштабе .Поскольку значения логарифмической шкалы почти никогда не сообщаются, я нашел ссылки, которые позволяют мне приблизить логарифмическую шкалу, используя общедоступные данные (среднее значение + 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, где сообщается о медиане и диапазоне.Если пользователь отменит выбор среднего значения / 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)})
})
}
Я видел других людей с похожими проблемами (например, Добавить реактивный фрейм данных в блестящем R ), но, похоже, нетпринятого ответа пока нет.Есть идеи о решениях или обходных решениях?Я открыт для любых идей, которые позволяют пользователям ограничивать видимые поля, но сохраняют все введенные данные независимо от того, отображаются ли они на самом деле.