Блестящий сюжет не отображает данные - PullRequest
Новая
       8

Блестящий сюжет не отображает данные

1 голос
/ 23 марта 2020

Я пытаюсь создать блестящее приложение для отображения случаев COVID-19 для 10 наиболее пострадавших стран с ежедневными обновлениями с сайта ECD C. Я хочу иметь возможность ограничивать количество случаев и смертей, используя ползунки, и выбирать периоды с датами (все уже добавлено). Код приведен ниже, но когда я запускаю приложение, я получаю пустой график, ось отображается правильно, но я не могу отобразить точки. Это должно быть в состоянии работать на любом компьютере, так как код просто загружает набор данных со страницы ECD C. Какие-нибудь решения? 

library(shiny)
library(readxl)
library(dplyr)
library(httr)
library(ggplot2)
library(plotly)

url <- paste("https://www.ecdc.europa.eu/sites/default/files/documents/COVID-19-geographic-disbtribution-worldwide-",format(Sys.time(), "%Y-%m-%d"), ".xlsx", sep = "")

GET(url, authenticate(":", ":", type="ntlm"), write_disk(tf <- tempfile(fileext = ".xlsx")))

data <- read_excel(tf)

include<-c("United_Kingdom","Italy","France","China",
           "United_States_of_America","Spain","Germany",
           "Iran","South_Korea","Switzerland")
ui <- fluidPage(

    titlePanel("COVID-19 Daily Confirmed Cases & Deaths"),

    sidebarLayout(
        sidebarPanel(
            checkboxGroupInput("Country", "Select Country", selected = NULL, inline = FALSE,
                         width = NULL),
            dateRangeInput("DateRep","Select Date Range", start = "2019-12-31", end = NULL),
            sliderInput("Cases","Select Cases Range", min = 1, max = 20000, value = NULL),
            sliderInput("Deaths", "Select Death Range", min = 1, max = 10000, value = 100),
            submitButton("Refresh")


        ),

        mainPanel(
           plotOutput("plot")
        )
    )
)

server <- function(input, output) {

    output$plot <- renderPlot({

        include<-input$Country

        plot_data<-filter(data, `Countries and territories` %in% include)%>%
            filter(between(input$Cases))

        plot_data%>% ggplot(aes(x=input$DateRep, y=input$Cases, size =input$Deaths, color = input$Country)) +
            geom_point(alpha=0.5) +
            theme_light()

    })
}

shinyApp(ui = ui, server = server)

Ответы [ 2 ]

0 голосов
/ 23 марта 2020

Я думаю, что было бы лучше определить и отфильтровать данные, которые вы хотите построить, в выражении reactive за пределами renderPlot. Это позволит вам более легко повторно использовать эти данные, и с моей точки зрения проще (* с моей точки зрения) использовать ggplot без ввода непосредственно в него.

Я включаю as.Date(DateRep) >= input$DateRep[1] & as.Date(DateRep) <= input$DateRep[2]) в filter, чтобы выбрать интервал между двумя выбранными датами. Поскольку столбец DateRep имеет формат POSIXct, вам необходимо использовать as.Date для его преобразования в формат, который производит dateRangeInput.

Вот результат: 

library(shiny)
library(readxl)
library(dplyr)
library(httr)
library(ggplot2)
library(plotly)

url <- paste("https://www.ecdc.europa.eu/sites/default/files/documents/COVID-19-geographic-disbtribution-worldwide-",format(Sys.time(), "%Y-%m-%d"), ".xlsx", sep = "")

GET(url, authenticate(":", ":", type="ntlm"), write_disk(tf <- tempfile(fileext = ".xlsx")))

data <- read_excel(tf)

include<-c("United_Kingdom","Italy","France","China",
           "United_States_of_America","Spain","Germany",
           "Iran","South_Korea","Switzerland")
ui <- fluidPage(

  titlePanel("COVID-19 Daily Confirmed Cases & Deaths"),

  sidebarLayout(
    sidebarPanel(
      checkboxGroupInput("Country", "Select Country", choices = include, selected = "France"),
      dateRangeInput("DateRep","Select Date Range", start = "2019-12-31", end = NULL),
      sliderInput("Cases","Select Cases Range", min = 1, max = 20000, value = NULL),
      sliderInput("Deaths", "Select Death Range", min = 1, max = 10000, value = 100),
      submitButton("Refresh")

    ),

    mainPanel(
      plotOutput("plot")
    )
  )
)

server <- function(input, output) {

  plot_data <- reactive({
    filter(data, `Countries and territories` %in% input$Country 
           & as.Date(DateRep) >= input$DateRep[1]
           & as.Date(DateRep) <= input$DateRep[2]) %>%
       filter(between(Cases, 1, input$Cases))
  })

  output$plot <- renderPlot({
    plot_data() %>% 
      ggplot(aes(x = as.Date(DateRep), y= Cases, size = Deaths, color = `Countries and territories`)) +
      geom_point(alpha=0.5) +
      theme_light()
  })
}

shinyApp(ui = ui, server = server)

enter image description here

0 голосов
/ 23 марта 2020

Я начал это исправлять, но не хватило времени ... так вот что я сделал, может быть, вы можете завершить это ... 

library(shiny)
library(readxl)
library(dplyr)
library(httr)
library(ggplot2)
library(plotly)

url <- paste("https://www.ecdc.europa.eu/sites/default/files/documents/COVID-19-geographic-disbtribution-worldwide-",format(Sys.time(), "%Y-%m-%d"), ".xlsx", sep = "")

GET(url, authenticate(":", ":", type="ntlm"), write_disk(tf <- tempfile(fileext = ".xlsx")))

data <- read_excel(tf)

ui <- fluidPage(

  titlePanel("COVID-19 Daily Confirmed Cases & Deaths"),

  sidebarLayout(
    sidebarPanel(
      uiOutput("country_checkbox"),
      dateRangeInput("DateRep","Select Date Range", start = "2019-12-31", end = NULL),
      sliderInput("Cases","Select Cases Range", min = 1, max = 20000, value = NULL),
      sliderInput("Deaths", "Select Death Range", min = 1, max = 10000, value = 100)
      #submitButton("Refresh")


    ),

    mainPanel(
      plotOutput("plot")
    )
  )
)

server <- function(input, output) {

  output$country_checkbox <- renderUI({
    countries <- unique(data.frame(data)[, "Countries.and.territories"])
    checkboxGroupInput("country", "Select Country", 
                       choices = countries,
                       selected = NULL, inline = FALSE,
                       width = NULL)
  })

  output$plot <- renderPlot({

    include<-input$country

    plot_data<-filter(data, `Countries and territories` %in% include)%>%
      filter(between(Cases, 1, input$Cases))

    plot_data%>% ggplot(aes(x=DateRep, y=Cases, size =Deaths, color = `Countries and territories`)) +
      geom_point(alpha=0.5) +
      theme_light()

  })
}

shinyApp(ui = ui, server = server)
...