闪亮的 dygraphs 包

Question

我正在尝试将 shiny 与 dygraphs 结合使用。我尝试生成一个图表，根据输入变量显示时间序列数据。数据样本如下：

     date      product sold
1  2015-01-01       a    1
2  2015-01-01       b   20
3  2015-02-01       a    2
4  2015-02-01       b   15
5  2015-03-01       a    3
6  2015-03-01       b   10
7  2015-04-01       a    4
8  2015-04-01       b    5
9  2015-05-01       a    5
10 2015-05-01       b    1

我想要的是带有产品变量复选框控件的时间序列图（查看产品 a、b 或两者）。

ui 和服务器代码是（shinydashboard 包）：

library(shiny)
library(dygraphs)
library(dplyr)
library(xts)


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({

  data_f <- filter(data_products,
               product==input$type)
  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)
  })
   }

  shinyApp(ui, server)

尝试了几种方法，但总是出错。在此先感谢您的任何建议。

Answer 1

这部分代码你要小心：

data_f <- filter(data_products,
               product==input$type)

在此示例中，根据您的选择，input$type 可以包含 0、1 或 2 个元素。如果它包含一个元素 "a" 或 "b" 那么一切都很好，但是在其他情况下您会收到错误或警告。

如果您没有在小部件中选择任何值，input$type 将变为 return NULL。因此，逻辑比较将失败并且您将得到错误。为避免这种情况 - 在使用丢失的输入之前 - 您可以使用 req 或 validate 函数，它们可以读作 "require that an input is available" 。 Here 您可以在 shiny 中阅读更多关于处理缺失输入的信息。

如果您同时选择了 "a" 和 "b"，product==input$type 将 return 发出警告，因为 == 不适用于多重比较。而不是将其更改为 %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

由于数据的新性质，您必须稍微更改服务器端的代码。我在代码中留下了评论

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)

闪亮的 dygraphs 包

Shiny with dygraphs package

dygraphs

shiny