这部分代码你要小心了：
data_f <- filter(data_products,
product==input$type)
在此示例中，根据您的选择，input$type 可以包含 0、1 或 2 个元素。如果它包含一个元素"a" 或"b"，那么一切都很好，但是在其他情况下，您会收到错误或警告。
如果您没有在小部件中选择任何值，input$type 将返回 NULL。因此，逻辑比较会失败，你会得到错误。为了避免这种情况，在使用丢失的输入之前，您可以使用req 或validate 函数，它们可以读作“要求输入可用”。 Here 你可以阅读更多关于在闪亮中处理缺失输入的信息。
如果您同时选择了"a" 和"b"，product==input$type 将返回警告，因为== 不适用于多个比较。而不是这个，只需将其更改为%in%。
因为你想要一个复选框，所以我将 selectInput 更改为 checkboxGroupInput
完整示例：
library(shiny)
library(dygraphs)
library(dplyr)
library(xts)
# I pasted your example data to exces and then readed it into R with these
# two lines of the code. It seems that product has to be a factor, because you
# use 'levels(data_products$product)'
# data_products <- as.data.frame(read_excel("~/Downloads/data.xlsx"))[-1]
# data_products$product <- as.factor(data_products$product)
ui <- dashboardPage(
skin="black",
dashboardHeader(title = "title"),
dashboardSidebar(
sidebarMenu(
menuItem("Results", tabName = "Result1", icon = icon("th"))
)),
dashboardBody(
tabItems(
tabItem(tabName = "Result1",
fluidRow(
dygraphOutput("Graph")
),
sidebarPanel(
uiOutput("output1")
)
)
)
)
)
server <- function(input, output) {
output$Graph <- renderDygraph({
req(input$type) # require that input$type is available
data_f <- filter(data_products,
product %in% input$type) # use "%in%" instead of "=="
xts(data_f$sold, as.Date(data_f$date, format = "%Y-%m-%d")) %>%
dygraph()
})
output$output1 <- renderUI({
# selectizeInput("type","Choose product",
# choices=levels(data_products$product), multiple=TRUE)
checkboxGroupInput("type", "Choose product",
choices = levels(data_products$product),
selected = levels(data_products$product))
})
}
shinyApp(ui, server)
已编辑：
如果您希望在选择a 和b 时有两行，则必须更改数据格式 - 您必须从长变为宽。这样做的原因是，您可以轻松地创建一个二元时间序列，xts 和 dygraph 将绘制两条单独的线。
使用 Hadley Wickham 的 reshape2 包可以轻松实现从长到宽。
# Copy data from your example
data_products <- read.table(con<-file("clipboard"),header=T)
data_products$product <- as.factor(data_products$product)
# Reshape
data_products <- dcast(data_products, date ~ product)
您的数据集现在看起来像这样：
date a b
1 2015-01-01 1 20
2 2015-02-01 2 15
3 2015-03-01 3 10
4 2015-04-01 4 5
5 2015-05-01 5 1
由于数据的新特性，您必须稍微更改服务器端的代码。我把 cmets 留在了代码中
ui <- dashboardPage(
skin = "black",
dashboardHeader(title = "title"),
dashboardSidebar(
sidebarMenu(
menuItem("Results", tabName = "Result1", icon = icon("th"))
)),
dashboardBody(
tabItems(
tabItem(tabName = "Result1",
fluidRow(
dygraphOutput("Graph")
),
sidebarPanel(
uiOutput("output1")
)
)
)
)
)
server <- function(input, output) {
output$Graph <- renderDygraph({
req(input$type) # require that input$type is available
# Due to the wide format we have to select columns
data_f <- data_products[, c("date", input$type)]
# univariate or bivariate time series
xts(data_f[-1], as.Date(data_f$date, format = "%Y-%m-%d")) %>%
dygraph()
})
output$output1 <- renderUI({
# Since we now have data in wide format, the choices are
# the names of columns (expect date)
checkboxGroupInput("type", "Choose product",
choices = names(data_products)[-1])
})
}
shinyApp(ui, server)