Блестящий с пакетом dygraphs

Question

Я стараюсь использовать блестящие с помощью диграфов. Я пытаюсь создать график, который будет отображать данные временных рядов в зависимости от входных переменных. Образец данных заключается в следующем:

 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 

То, что я хочу, это график временного ряда с галочками для переменного продукта (чтобы увидеть продукт а, б или оба).

пользовательский интерфейс и код сервера являются (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 собирается вернуть 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) 

---

EDITED:

Если вы хотите иметь две строки, когда выбраны a и b, вы должны изменить формат своих данных - вам нужно перейти от длинного к широкому. Причина этого заключается в том, что тогда вы можете легко создать двумерный временной ряд с xts и dygraph будет строить две отдельные строки.

Переход от длинного к широкому легко осуществляется с помощью пакета 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)