Corona Shiny Project 5 - Chart with DateInput

2020-04-11

Development, R, Shiny, Corona Shiny App

Page content

공지

이번에 준비한 튜토리얼은 제 강의를 듣는 과거-현재-미래 수강생분들을 위해 준비한 자료이다. 많은 도움이 되기를 바란다

이번에 준비한 Tutorial 코로나 세계현황을 Shiny Dashboard로 만들어 가는 과정을 담았다.

I. Shiny Tutorial 소개

처음 shiny를 접하거나 shiny의 전체 튜토리얼이 궁금한 사람들을 위해 이전 글을 소개한다.

II. Shiny Project

현재 진행중인 프로젝트가 궁금하다면 아래를 확인해보자.

III. Date Control

이제 프로젝트의 마지막에 와 있다. 오늘의 내용은 간단하게 표현하면 날짜에 따라 그래프가 달라져야 하는 것을 어떻게 기능적으로 구현할 것인가에 대한 과제가 들어있다.

또한, 늘 그래왔던 것처럼, Sample로 구현을 먼저 한 후에 응용을 하면 된다. 당연히 처음에는 어렵다. 그러나, 1-2번 반복해서 하다보면, 자연스럽게 익히게 되니, 크게 염려하지 않기를 바란다.

(1) DateInput 핸들링

project_03에서 확인해야 하는 내용의 소스코드를 그대로 사용해야 하니, project_03 내용이 숙지가 되지 않았으면 다시 공부할 것을 권한다. 강사는 글의 편의성을 위해, 나눠서 작성을 했다. 우선 Global Bubble Chart부터 다룬다. 각 코드에 대한 자세한 설명은 여기에서는 생략한다.

(A) Global Chunk Code

Global Chunk Code는 아래와 같이 되어 있을 것이다. 본 포스트에서 필요한 데이터는 corona3 데이터셋이다. 다시 Review하는 마음으로 코드를 작성한다.

library(plotly)    # 동적 시각화
library(viridis)   # 색상 관련 패키지
library(readxl)    # 엑셀파일 데이터 수집
library(tidyverse) # 데이터 가공 및 ggplot2 시각

# get code data
url <- 'https://pkgstore.datahub.io/JohnSnowLabs/country-and-continent-codes-list/country-and-continent-codes-list-csv_csv/data/b7876b7f496677669644f3d1069d3121/country-and-continent-codes-list-csv_csv.csv'

# Country Code 변수명 재정의
country_code <- read.csv(url, stringsAsFactors = FALSE) %>% 
  select(Continent_Name, Three_Letter_Country_Code) %>% 
  rename(continent_code = Three_Letter_Country_Code)

# Covid_19 변수명 재정의
corona %>% 
  rename(date = dateRep, 
         country = countriesAndTerritories, 
         continent_code = countryterritoryCode) -> corona2 

# continent_code 변수 기준으로 데이터 통합
corona3 <- left_join(corona2, country_code)

# 결과 확인
glimpse(corona3)  

Rows: 9,339
Columns: 11
$ date           <date> 2020-04-05, 2020-04-04, 2020-04-03, 2020-04-02, 2…
$ day            <dbl> 5, 4, 3, 2, 1, 31, 30, 29, 28, 27, 26, 25, 24, 23,…
$ month          <dbl> 4, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,…
$ year           <dbl> 2020, 2020, 2020, 2020, 2020, 2020, 2020, 2020, 20…
$ cases          <dbl> 35, 0, 43, 26, 25, 27, 8, 15, 16, 0, 33, 2, 6, 10,…
$ deaths         <dbl> 1, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0,…
$ country        <chr> "Afghanistan", "Afghanistan", "Afghanistan", "Afgh…
$ geoId          <chr> "AF", "AF", "AF", "AF", "AF", "AF", "AF", "AF", "A…
$ continent_code <chr> "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "AFG", "…
$ popData2018    <dbl> 37172386, 37172386, 37172386, 37172386, 37172386, …
$ Continent_Name <chr> "Asia", "Asia", "Asia", "Asia", "Asia", "Asia", "A…

(B) Slide Bar Chunk Code

corona3 데이터셋을 확보했다면, 이제는 Slide Bar를 만들어본다. dateInput 코드를 입력한다.

Inputs {.sidebar data-width=300}
-----------------------------------------------------------------------
원하는 날짜에 놓고 `Button`을 누르세요. 

```r
h4("Step 1. Click Global Bubble Chart")
h4("Step 2. Change Date")
dateInput("bubbleDate", "Date:", value = "2020-03-01")

h4("Check if bubble is moving by date")
```

(C) flexdashboard Code

마지막으로 Global Bubble Chart 탭에서 그래프가 출력되는지 확인한다.

# Create data Reactive
corona_bubble_df <- reactive({
  corona3 %>% 
  filter(date <= "2020-04-05", !is.na(cty_code)) %>% 
  select(-c(day, month, year, geoId)) %>%
  # Reorder countries to having big bubbles on top
  arrange(date) %>% 
  group_by(country) %>% 
  mutate(cum_cases = cumsum(cases), 
         cum_deaths = cumsum(deaths)) %>% 
  # prepare text for tooltip
  mutate(text = paste("Country: ", country, "\ntoday cases: ", cases, "\ntoday_deaths: ", deaths, "\ntotal_cases: ", cum_cases, "\ntotal_deaths: ", cum_deaths, sep="")) %>% 
  filter(date == "2020-04-05") %>% 
  distinct(date, cases, deaths, country, .keep_all = TRUE)
})

renderPlotly({
  # Classic ggplot
  p <- ggplot(corona_bubble_df(), aes(x=cases, y=deaths, size = popData2018, color = Continent_Name, text=text)) +
    geom_point(alpha=0.7) + 
    scale_x_log10() + 
    scale_size(range = c(1.4, 19), name="Population (M)") +
    scale_color_viridis(discrete=TRUE, guide=FALSE) +
    theme_minimal() +
    theme(legend.position="none")
  
  ggplotly(p, tooltip="text")
})

위 소스코드를 새로운 flexdashboard template 정상적으로 실행했다면 아래와 같이 나타나면 정상이다.

(D) 날짜 입력값 자동화 코드

문제는 날짜를 바꿔도 그래프는 달라지지 않는다. 왜 그럴까? reactive dataset 코드를 따라 작성했다면, filter(date == 2020-04-05) 이와 같이 입력한 것을 확인할 수 있을 것이다. 즉, 2020-04-05 이 부분을 입력값으로 대체를 해야 한다. 아래와 같이 수정한다.

filter(date == "2020-04-05", !is.na(cty_code)를 filter(date <= as.Date(as.character(input$bubbleDate)), !is.na(cty_code)) 수정한다.
filter(date == "2020-04-05")를 filter(date == as.Date(as.character(input$bubbleDate))로 수정한다.

# Create data Reactive
corona_bubble_df <- reactive({
  corona3 %>% 
  filter(date <= as.Date(as.character(input$bubbleDate)), !is.na(cty_code)) %>% 
  select(-c(day, month, year, geoId)) %>%
  # Reorder countries to having big bubbles on top
  arrange(date) %>% 
  group_by(country) %>% 
  mutate(cum_cases = cumsum(cases), 
         cum_deaths = cumsum(deaths)) %>% 
  # prepare text for tooltip
  mutate(text = paste("Country: ", country, "\ntoday cases: ", cases, "\ntoday_deaths: ", deaths, "\ntotal_cases: ", cum_cases, "\ntotal_deaths: ", cum_deaths, sep="")) %>% 
  filter(date == as.Date(as.character(input$bubbleDate))) %>% 
  distinct(date, cases, deaths, country, .keep_all = TRUE)
})

날짜를 입력받는데, as.character()가 나온 것에 대해 의구심이 생길 수 있는데, 이 부분을 다루려면 R의 Shiny의 Date Input 및 R 프로그래밍에서의 Date Type에값을 처리하는 것에 대한 부가적인 설명이 필요해서 일단 여기에서는 설명하지 않는다. (강사가 이 문제를 푸는데 약 30-40분 시간을 허비했다!)
input$bubbleDate는 뭘까? shiny의 input & output 개념에 대한 이해도가 필요하며, 이 기본적인 개념은 shiny tutorial 02 - Shiny Structure에서 확인한다.

그러면 이제 다른 날짜를 클릭하면, 그래프가 달라지는 것을 확인할 수 있을 것이다.

정상적으로 바뀐 것을 확인을 하였다면, 수정 후 다시 재 배포하면 된다.

IV. 결론

간단하게 소스코드 1-2줄 수정으로 의미있는 시각화가 구현되었다. 이제 본 프로젝트의 마지막이다. 다음 튜토리얼에서는 날짜의 범위(Range)를 이용하여 자동으로 그래프가 변화되는 것을 만들어본다.

이글을 읽는 사람들에게 작게나마 도움이 되기를 바란다.

Pray for Victims of Covid_19. Contribution to them with this tutorial.

V. Reference

Shiny Tutorial. Lession 4 Display reactive output. from https://shiny.rstudio.com/tutorial/written-tutorial/lesson4/