У меня есть приложение Shiny, которое показывает редактируемое rhandsontable
и отображает вывод таблицы в виде графика.Все хорошо, пока я отправляю «полный» кадр реактивных данных на rhandsontable
, но когда я хочу установить подмножество отображаемых значений selectInput
, приложение прерывается со следующим сообщением об ошибке:
Прослушивание http://127.0.0.1:5362
Предупреждение. Ошибка в матрице: «данные» должны быть векторного типа, были «NULL»
Трассировка стека (самое внутреннее первое): 60:матрица 59: 58: do.call 57: hot_to_r 56: наблюдатель] 1: runApp
ОШИБКА: [on_request_read] сброс соединения по пиру
Есть идеи, как это сделать?В приведенном ниже сценарии вы можете воспроизвести проблему, комментируя / раскомментируя определения react_df()
.
library(shiny)
library(rhandsontable)
library(dplyr)
library(ggplot2)
#### based on the SO code found here: https://stackoverflow.com/a/52607643/6327771
df <- data.frame(country = c(rep('US', 5), rep('UK', 5)),
date = rep(as.Date(c('2018-01-01', '2018-02-01', '2018-03-01', '2018-04-01', '2018-05-01')), 2),
val = rep(sample(6:8, size = 5, replace = T), 2))
ui <- fluidPage(
selectInput("country", "Choose the Country",
choices = df %>% unique() %>% pull(country),
selected = 'US',
multiple = FALSE),
rHandsontableOutput('table'), # editable table with bar heights
plotOutput('plot')#, # bar plot that takes values from the drop-down menu and the editable table
)
server <- function(input,output,session)({
#### REACTIVE INPUT: SUBSETTED VERSUS COMPLETE DATA ####
## subsetted version of react_df()
# react_df <- reactive({
# df %>%
# filter(country == input$country)
# })
## complete version of react_df()
react_df <- reactive({df})
values <- reactiveValues(data = NULL)
observe({
values$data <-react_df()
})
#observe the table
observe({
if(!is.null(input$table))
values$data <- hot_to_r(input$table)
})
# output the table
output$table <- renderRHandsontable({
req(values$data)
rhandsontable(values$data)
})
# update the plot
output$plot <- renderPlot({
req(values$data)
ggplot(values$data, aes(date, val)) +
geom_line() +
geom_point()
})
})
shinyApp(ui = ui, server = server)