Я пытаюсь вычислить несколько значений на основе пользовательского ввода, указанного в R shiny app
.Часть пользовательского ввода зависит от некоторых других настроек ввода (поэтому пользовательский интерфейс является интерактивным, а диапазоны ползунков зависят от другого значения; это решается с помощью renderUI
).Пока это работает довольно хорошо.На стороне сервера я хочу вычислить значения результатов в рамках реактивной функции.Реактивная функция возвращает массив / фрейм данных, который заполняется этими значениями, которые зависят от входных данных ползунков.Весь сценарий работает хорошо и обеспечивает правильный вывод, но я получаю некоторые сообщения об ошибках / предупреждениях, в которых я не знаю, как их обработать и почему они возникают (Warning: Error in <-: number of items to replace is not a multiple of replacement length
).
Вот пример для воспроизведениясообщения об ошибках:
library(shiny)
ui <- fluidPage(
titlePanel("Test"),
sidebarLayout(position="left",
sidebarPanel(selectInput(inputId = "Category", label="Category to choose",
choices = list("A" = "A", "B" = "B"),
selected = "A"),
sliderInput(inputId = "sl_1",
label = "Test slider",
value = 3, min = 1, max = 5),
uiOutput("slider_test")),
mainPanel(tableOutput("outtable"),
tableOutput("outtext"))))
server <- function(input, output){
# Dynamic slider ranges depending on turbine type
slider_param <- reactive({
par_ls <- list()
if(input$Category=="A"){
par_ls$range <- 20
par_ls$max <- 1000
}
if(input$Category=="B"){
par_ls$range <- 10
par_ls$max <- 500
}
return(par_ls)
})
output$slider_test <- renderUI({
sliderInput(inputId = "sl_2",
label = "Test slider",
value = slider_param()$range, min = 1, max = slider_param()$max)})
## Calculate parameters on the fly an store in data.frame() for display
output_reactive <- reactive({
results_array <- array(data = NA,
dim = c(1,2),
dimnames = list(c("row1"),
c("colA","colB")))
results_array["row1","colA"] <- input$sl_2
results_array["row1","colB"] <- input$sl_1*input$sl_2
return(as.data.frame(results_array))
})
output$outtext <- renderText({input$sl_2})
output$outtable <- renderTable({
output_reactive()})
}
shinyApp(ui = ui, server = server)
Я предполагаю, что эта ошибка может быть вызвана тем, как (то есть, в каком порядке) генерируется / обрабатывается выходное значение из ползунка input$sl_2
.Поскольку input$sl_2
обновляется после установки input$Category
(то есть условного ползунка), input$sl_2
может быть пустым в начале.Например, это приводит к тому же виду ошибки:
results_array <- array(data = NA,
dim = c(1,2),
dimnames = list(c("row1"),
c("colA","colB")))
sl_2 <- c()
results_array["row1","colA"] <-sl_2
Решение: Я нашел решение, вставив req()
в renderTable()
.req()
скажет блестящему визуализировать эту таблицу только тогда, когда ввод $ sl_2 не пуст [https://stackoverflow.com/a/43619933/1035346]
output$outtable <- renderTable({
req(input$sl_2)
output_reactive()})