Modern Data Science with R_Cpt11

Interactive data graphics

동적 데이터 그래픽을 만들기 위한 기법들을 알아보자.

11.1. Rich Web content using D3.js and htmlwidgets

JavaScript는 웹 개발자가 클라이언트 측 웹 응용프래그램을 만들 수 있도록 하는 프로그래밍 언어다. PHP나 Ruby같은 서버 측 스크립팅 언어보다 클라이언트 상호작용에 더 잘 반응한다. D3나 D3.js라고 불리며, R과 D3사이의 다리 역할을 하는 htmlwidgets 패키지가 만들어졌다.

11.1.1. Leaflet

htmlwidget에서 가장 주목받는 것은 Leaflet이다. Leaflet은 OpenStreetMaps API를 사용하여 동적지형공간 지도를 그릴 수 있는 기능을 제공한다.

11.1.2. Plot.ly

plotly패키지를 통해 제공되며, plotly.js JavaScript 라이브러리를 기반으로 하는 온라인 동적 데이터 시각화 기능이다. ggplotly()함수를 사용하여 ggplot2 오브젝트를 plotly 오브젝트로 변환할 수 있다는 장점을 갖는다.

EX: 시간 경과에 따른 비틀즈 멤버 4인 이름의 미국 출생 빈도

library(babynames)
Beatles <- babynames %>%
  filter(name %in% c("John", "Paul", "George", "Ringo") & sex == "M")

beatles_plot <- ggplot(data = Beatles, aes(x = year, y = n)) +
  geom_line(aes(color = name), size = 2)

beatles_plot

library(plotly)

Registered S3 method overwritten by 'data.table':
  method           from
  print.data.table     

다음의 패키지를 부착합니다: ‘plotly’

The following object is masked from ‘package:mosaic’:

    do

The following object is masked from ‘package:ggplot2’:

    last_plot

The following object is masked from ‘package:stats’:

    filter

The following object is masked from ‘package:graphics’:

    layout

ggplotly(beatles_plot)

위의 ggplot과 같은 그래프가 플로팅되지만, 마우스를 올리면 상세한 정보가 표현되고 상단의 추가 기능들이 지원되는 것을 볼 수 있다.

11.1.3. DataTables

DT패키지는 데이터테이블을 interactive형식으로 빠르게 만들어주는 기능을 제공한다. 이를 활용하면 자동으로 테이블을 검색하고 정렬하며, 페이징할 수 있다.


EX: DT에 의해 렌더링 된 Beatles 테이블 살펴보기

library(DT)
datatable(Beatles, options = list(pageLength = 10))

11.1.4. dygraphs

시간 간격에 따라 브러싱하고 확대/축소할 수 있는 상호작용 시계열 플롯을 생성하는 방법이다.

library(dygraphs)
Beatles %>%
  filter(sex == "M") %>%
  select(year, name, prop) %>%
  tidyr::spread(key = name, value = prop) %>%
  dygraph(main = "Popularity of Beatles names over time") %>%
  dyRangeSelector(dateWindow = c("1940", "1980"))

11.1.5. Streamgraphs

면적을 통해 나타내는 시계열 그래프를 생성하는 방법이다.

library(devtools)

devtools::install_github("hrbrmstr/streamgraph")

library(streamgraph)

Beatles %>% streamgraph(key = "name", value = "n", date = "year") %>%
  sg_fill_brewer("Accent")

11.2. Dynamic visualization using ggvis

EDA, 탐색적 데이터 분석을 위한 대화형 그래픽을 만드는 도구를 제공한다. Vega JavaScript 라이브러리를 사용한다.

library(ggvis)

다음의 패키지를 부착합니다: ‘ggvis’

The following objects are masked from ‘package:plotly’:

    add_data, hide_legend

The following objects are masked from ‘package:mosaic’:

    prop, props

The following object is masked from ‘package:Matrix’:

    band

The following object is masked from ‘package:ggplot2’:

    resolution

John <- filter(Beatles, name=="John")
all_values <- function(x) {
  if (is.null(x)) return(NULL)
  row <- John[John$year == x$year, ]
  paste0(names(row), ": ", format(row), collapse = "<br />")
}

John %>%
  ggvis(~n, ~prop, fill = ~year) %>%
  layer_points() %>%
  add_tooltip(all_values, "hover")

필요한 패키지를 로딩중입니다: shiny

다음의 패키지를 부착합니다: ‘shiny’

The following objects are masked from ‘package:DT’:

    dataTableOutput, renderDataTable

The following object is masked from ‘package:mclust’:

    em

Showing dynamic visualisation. Press Escape/Ctrl + C to stop.

NA

이름이 John인 남성의 비율을 시각화해 보았다. ggvis는 우측 하단의 viewer에 출력되는 것을 확인할 수 있다.

11.3. Interactive Web apps with Shiny

Shiny는 대화형 웹 응용프로그램을 만들 수 있는 R 프레임워크다. 앱의 프로토타입을 쉽게 만들고 배포할 수 있는 높은 수준의 구조를 제공하므로 아주 매력적이다. ui.R파일로 유저 인터페이스를 제어하고 server.R파일로 결과물을 표시하여 Shiny앱을 만든다.

EX: 사용자가 비틀즈 중 최애 멤버를 골라서 그를 포함하고 시작, 종료 연도를 선택하도록 하여 그와 같은 이름의 아기 데이터 세트를 탐색하는 동적 웹 앱을 만들어보아라.

Shiny 웹 앱을 만드는 것은 지금까지 R에서 코드를 짜온 것과 조금 다르다. R script나 R notebook을 생성하는 것이 아니라, Shiny Web App을 생성하여 ui.R과 server.R파일을 생성한 뒤 각 파일 내용을 구성하고 상단의 Run App을 클릭하면 위 이미지와 같이 웹 앱이 출력된다. 주의사항으로는 shiny 파일이 생성된 폴더를 working directory로 설정해주어야 한다는 점이 있다.

11.4. Further customization

ggplot2 테마를 사용자 정의 하는 방법에 대해 알아보았다. ggplot2 테마로는 축 레이블, 제목, 격자선 등 57가지의 속성 목록이 있으며, 기본 테마는 theme_gray()이다.

panel.background와 panel.grid.major는 테마의 배경과 격자선을 제어한다. ggplot2에 내장된 bw() 테마와 비교해보자.

library(patchwork)
thm_gray <- beatles_plot + theme_gray()
thm_bw <- beatles_plot + theme_bw()

thm_gray/thm_bw

두 플롯의 차이점으로 아래 bw테마의 배경이 흰색이고 플롯 테두리도 굵은 선으로 구분되고 있음을 알 수 있다.

theme()함수를 이용하여 테마를 바로 수정할 수도 있다.

beatles_plot + theme(panel.background = element_rect(fill = "cornsilk"),
                     panel.grid.major = element_line(color = "dodgerblue"))

팁: colors() 함수로 R의 내장 색상을 볼 수 있다.

11.5. Hot dog eating (예제)

R의 플로팅을 이용하여 위와 같은 원본 자료와 유사하게 만들어보아라.

hd <- readr::read_csv(
  "http://datasets.flowingdata.com/hot-dog-contest-winners.csv")

Rows: 31 Columns: 5── Column specification ─────────────────────────────────────────────────────────────────────────────
Delimiter: ","
chr (2): Winner, Country
dbl (3): Year, Dogs eaten, New record
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

names(hd) <- gsub(" ", "_", names(hd)) %>% tolower()
glimpse(hd)

Rows: 31
Columns: 5
$ year       <dbl> 1980, 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 19…
$ winner     <chr> "Paul Siederman & Joe Baldini", "Thomas DeBerry", "Steven Abrams", "Luis Llamas"…
$ dogs_eaten <dbl> 9.10, 11.00, 11.00, 19.50, 9.50, 11.75, 15.50, 12.00, 14.00, 13.00, 16.00, 21.50…
$ country    <chr> "United States", "United States", "United States", "Mexico", "Germany", "United …
$ new_record <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1, 1, 0, 1, 0, 1,…

먼저, 데이터셋을 가져와서 살펴보았다. 1980년 이전의 데이터가 없으므로 원본 자료를 보고 직접 추가해주자.

new_data <- data.frame(
  year = c(1979, 1978, 1974, 1972, 1916),
  winner = c(NA, "Walter Paul", NA, NA, "James Mullen"),
  dogs_eaten = c(19.5, 17, 10, 14, 13),
  country = rep(NA, 5), new_record = c(1,1,0,0,0)
  )

hd <- bind_rows(hd, new_data)
glimpse(hd)

Rows: 36
Columns: 5
$ year       <dbl> 1980, 1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1992, 19…
$ winner     <chr> "Paul Siederman & Joe Baldini", "Thomas DeBerry", "Steven Abrams", "Luis Llamas"…
$ dogs_eaten <dbl> 9.10, 11.00, 11.00, 19.50, 9.50, 11.75, 15.50, 12.00, 14.00, 13.00, 16.00, 21.50…
$ country    <chr> "United States", "United States", "United States", "Mexico", "Germany", "United …
$ new_record <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1, 1, 0, 1, 0, 1,…

이제 플로팅에 사용할 하위 집합을 정의하자. 예제에서는 2008년도 이전의 데이터로 정의하기로 한다.

xlabs <- c(1916, 1972, 1980, 1990, 2007)
ylabs <- seq(from = 0, to = 70, by = 10)

hd_plot <- hd %>% filter(year < 2008)

p <- ggplot(data = hd_plot, aes(x = year, y = dogs_eaten)) +
  geom_bar(stat = "identity")

p

아직 원본을 따라잡기에는 차이가 너무 커보인다. y축을 그리지 않는 대신 y값 레이블을 추가해보자.

ticks_y <- data.frame(x = 1912, y = ylabs)

text <- bind_rows(
  # Frank Dellarosa
  data.frame(x = 1951.5, y = 37,
             label = paste("Frank Dellarosa eats 21 and a half HDBs over 12\n",
                           "minutes, breaking the previous record of 19 and a half."), adj = 0),
  # Joey Chestnut
  data.frame(x = 1976.5, y = 69,
             label = paste("For the first time since 1999, an American\n",
                           "reclaims the title when Joey Chestnut\n",
                           "consumes 66 HDBs, a new world record."), adj = 0),
  # Kobayashi
  data.frame(x = 1960.5, y = 55,
             label = paste("Through 2001-2005, Takeru Kobayashi wins by no less\n",
                           "than 12 HDBs. In 2006, he only wins by 1.75. After win-\n",
                           "ning 6 years in a row and setting the world record 4 times,\n",
                           "Kobayashi places second in 2007."), adj = 0),
  # Walter Paul
  data.frame(x = 1938, y = 26, label = "Walter Paul sets a new world record with 17 HDBs.", adj = 0),
  # James Mullen
  data.frame(x = 1917, y = 10, label = "James Mullen wins the inaugural contest,
  scarfing 13 HDBs. Length of contest unavailable.", adj = 0),
  data.frame(x = 1935, y = 72, label = "NEW WORLD RECORD"),
  data.frame(x = 1914, y = 72, label = "Hot dogs and buns (HDBs)"),
  data.frame(x = 1940, y = 2,
             label = "*Data between 1916 and 1972 were unavailable"),
  data.frame(x = 1922, y = 2, label = "Source: FlowingData")
)

또한 원본에 많은 주석이 있으므로 이를 단일 데이터 프레임으로 수집하고 플로팅해보자.

segments <- bind_rows(
  data.frame(x = c(1984, 1991, 1991, NA), y = c(37, 37, 21, NA)),
  data.frame(x = c(2001, 2007, 2007, NA), y = c(69, 69, 66, NA)),
  data.frame(x = c(2001, 2007, 2007, NA), y = c(69, 69, 66, NA)),
  data.frame(x = c(1995, 2006, 2006, NA), y = c(58, 58, 53.75, NA)),
  data.frame(x = c(2005, 2005, NA), y = c(58, 49, NA)),
  data.frame(x = c(2004, 2004, NA), y = c(58, 53.5, NA)),
  data.frame(x = c(2003, 2003, NA), y = c(58, 44.5, NA)),
  data.frame(x = c(2002, 2002, NA), y = c(58, 50.5, NA)),
  data.frame(x = c(2001, 2001, NA), y = c(58, 50, NA)),
  data.frame(x = c(1955, 1978, 1978), y = c(26, 26, 17)))

p + 
  geom_bar(stat = "identity", aes(fill = factor(new_record))) +
  geom_hline(yintercept = 0, color = "darkgray") +
  scale_fill_manual(name = NULL,
                    values = c("0" = "#006f3c", "1" = "#81c450")) +
  scale_x_continuous(name = NULL, breaks = xlabs, minor_breaks = NULL,
                     limits = c(1912, 2008), expand = c(0, 1)) +
  scale_y_continuous(name = NULL, breaks = ylabs, labels = NULL,
                     minor_breaks = NULL, expand = c(0.01, 1)) +
  geom_text(data = ticks_y, aes(x = x, y = y + 2, label = y), size = 3) +
  ggtitle("Winners from Nathan's hot dog eating contest") +
  geom_text(data = text, aes(x = x, y = y, label = label),
            hjust = "left", size = 3) +
  geom_path(data = segments, aes(x = x, y = y), col = "darkgray") +
  geom_rect(xmin = 1933, ymin = 70.75, xmax = 1934.3, ymax = 73.25,
            fill = "#81c450", color = "white") +
  guides(fill = FALSE) +
  theme(panel.background = element_rect(fill = "white"),
        panel.grid.major.y = element_line(color = "gray", linetype = "dotted"),
        plot.title = element_text(size = rel(2)),
        axis.ticks.length = unit(0, "cm"))

경고: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as of ggplot2 3.3.4.

처음에 비하면 원본과 많이 비슷한 플로팅을 할 수 있게 되었다.