Shiny package 绘制 COVID-19 Plot

Shiny package 是在R中进行数据分析可视化非常著名的一个包，我们就采用这个包来展示他的一些功能。 数据来源和前期数据处理的解释，请参考上一篇文章 R绘制COVID-19新增病例趋势图 ，这里直接放上前半部分的程序。

#清空工作环境
rm(list = ls())
options(digits = 4)

library(readxl)
library(dplyr)
library(shiny)
library(ggplot2)
covid <- read.csv("owid-covid-data.csv")
country <- read_excel("国家和地区代码.xlsx",
                     col_names=TRUE)

covid1 <- transform(covid, 
                    peo_vac=people_vaccinated/10000, 
                    peo_fvac=people_fully_vaccinated/10000,
                    ana_new=new_cases,
                    ana_dea=new_deaths,
                    low=0)

covidvac1 <- subset(covid1, subset = (peo_vac!="NA"), select = c(iso_code, date, people_vaccinated_per_hundred, people_fully_vaccinated_per_hundred))
covidvac2 <- aggregate(covidvac1, by = list(covidvac1$iso_code), FUN = last)
covidvac3 <- rename(covidvac2, c(peo_vac1 = "people_vaccinated_per_hundred", peo_fvac1 = "people_fully_vaccinated_per_hundred"))
covid2 <- left_join(covid1,
                    covidvac3,
                    by=c("iso_code"="iso_code", "date"="date"))
                    
country1 <- subset(country, 
                   subset = (X6!="NA"), 
                   select = c(X2,X3,X6))

anadata1 <- left_join(covid2,
                      country1,
                      by=c("iso_code"="X6"))

#定义移动平均数的函数
mav <- function(a,n){
  stats::filter(a,rep(1/n,n),sides = 1)
}
anadata2 <- transform(anadata1,
                      mean_new=mav(ana_new,7),
                      mean_dea=mav(ana_dea,7),
                      country_code=paste(iso_code,"_",X2,"_",X3))

countryname <- unique(anadata2$country_code)

接下来就是 shiny 包，准备针对每个国家绘制 新增病例、死亡、接种疫苗 三个图形，UI 设计程序如下：

ui <- fluidPage(
  titlePanel("COVID-19"),
  sidebarLayout(
    sidebarPanel(
      selectInput("country_code",
                  "Country:",
                  countryname),
      radioButtons("ratio", label = "R Plot",
                   choices = list("新增病例" = 1, "死亡" = 2, "接种疫苗" = 3),
                   selected = 1)
    ),
    mainPanel(
      h2(textOutput("textoutput")),
      plotOutput("plotoutput")
    )
  )
)

SERVER 服务器端程序基本同上一篇的文章的 ggplot2 绘图。

server <- function(input, output){
  formulaText <- reactive({
    input$country_code
  })
  
  output$textoutput <- renderText({
    formulaText()
  })
  
  output$plotoutput <- renderPlot({
    plotdata <- switch (input$country_code,
        subset(anadata2,country_code==input$country_code)
    )
    
    p1 <- ggplot(plotdata,aes(x=as.Date(date))) + 
      {if(input$ratio == 1) geom_col(aes(y=ana_new,fill="g_col"))} +
      {if(input$ratio == 2) geom_col(aes(y=ana_dea,fill="g_col"))} +
      {if(input$ratio == 3) geom_area(aes(y=peo_vac,fill="g_area1"))} +
      {if(input$ratio == 3) geom_area(aes(y=peo_fvac,fill="g_area2"))} +
      {if(input$ratio == 1) geom_line(aes(y=mean_new,color="g_line"),size=1)} +
      {if(input$ratio == 2) geom_line(aes(y=mean_dea,color="g_line"),size=1)} +
      {if(input$ratio == 3) geom_text(aes(y=peo_vac, label=peo_vac1))} +
      {if(input$ratio == 3) geom_text(aes(y=peo_fvac, label=peo_fvac1))} +
      
      labs(x=NULL,y=NULL) +
      scale_x_date(date_label="%y/%m/%d",
                   date_breaks = "3 month",
                   minor_breaks = "1 month") +
      {if(input$ratio == 1) scale_fill_manual(breaks = c("g_col"), 
                             values = c("#cad5e5"), 
                             label = c("New Case"))} + 
      {if(input$ratio == 2) scale_fill_manual(breaks = c("g_col"), 
                                              values = c("#c5c4c5"), 
                                              label = c("Death"))} + 
      {if(input$ratio == 3) scale_fill_manual(breaks = c("g_area1", "g_area2"), 
                                              values = c("#b9cfe7", "#8ca6ce"), 
                                              label = c("Vaccined", "Fully Vaccined"))} +
      {if(input$ratio == 1) scale_color_manual(breaks = c("g_line"),
                                               values = c("blue"), 
                                               label = c("Monving Average"))} +
      {if(input$ratio == 2) scale_color_manual(breaks = c("g_line"),
                                               values = c("#616161"), 
                                               label = c("Monving Average"))} +
      
      theme(plot.title =element_text(hjust = 0.5, vjust = 0.5), 
            legend.position = "bottom", 
            legend.title = element_blank(), 
            legend.background = element_blank()) 
    
    p2 <- p1 + theme(panel.background=element_rect(fill='transparent', 
                                                   color='gray'),
                     legend.key=element_rect(fill='transparent', 
                                             color='transparent'))
    p2
  })
}

最后就是 run script。

#shinyApp(ui = ui, server = server)