R을 활용한 데이터 시각화

​

​

서강대학교

미디어&엔터테인먼트학과

사영준

​

2024. 07. 26

쉽게 배우는 R을 활용한 데이터 분석 실습 및 취재보도

한국언론진흥재단 대구지사

강사 소개: 사영준

• 서강대학교 지식융합미디어대학 미디어&엔터테인먼트학과 부교수
• 일반대학원 신문방송학과, 메타버스전문대학원, 미디어커뮤니케이션특수대학원 전임 교수
• Ph.D. in Media and Information Studies, Michigan State University
• M.E. in Culture Technology, KAIST
• B.S. in Industrial Engineering, B.A. in Statistics, SNU
• Teaching: Data and AI, Introduction to Data Science, Understanding of Human-Media Interaction, Virtual Human Interaction, Digital Media Data Analytics
• Research interests: Human-Media Interaction, Virtual Human Interaction, Data Science

목차

• R을 활용한 데이터 가공 및 변수 생성
• 데이터 필터링과 여러 데이터의 결합
• 기술통계를 이용한 변수 생성
• R을 활용한 데이터 시각화 실습과 응용
• 시각화를 통한 변수들의 관계 표현
• R을 이용한 시각화 실습
• 스토리텔링을 통한 시각화 응용 기법

R을 활용한 데이터 가공 및 변수 생성

• 데이터 필터링과 여러 데이터의 결합
• 기술통계를 이용한 변수 생성

​

• 2일차

데이터 필터링

library(nycflights13)

library(tidyverse)

#> ── Attaching core tidyverse packages ───────────────────── tidyverse 2.0.0 ──

#> ✔ dplyr 1.1.4 ✔ readr 2.1.5

#> ✔ forcats 1.0.0 ✔ stringr 1.5.1

#> ✔ ggplot2 3.5.1 ✔ tibble 3.2.1

#> ✔ lubridate 1.9.3 ✔ tidyr 1.3.1

#> ✔ purrr 1.0.2

#> ── Conflicts ─────────────────────────────────────── tidyverse_conflicts() ──

#> ✖ dplyr::filter() masks stats::filter()

#> ✖ dplyr::lag() masks stats::lag()

#> ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

https://r4ds.hadley.nz/data-transform

flights

> flights

# A tibble: 336,776 × 19

year month day dep_time sched_dep_time dep_delay arr_time sched_arr_time arr_delay carrier flight tailnum origin

<int> <int> <int> <int> <int> <dbl> <int> <int> <dbl> <chr> <int> <chr> <chr>

1 2013 1 1 517 515 2 830 819 11 UA 1545 N14228 EWR

2 2013 1 1 533 529 4 850 830 20 UA 1714 N24211 LGA

3 2013 1 1 542 540 2 923 850 33 AA 1141 N619AA JFK

4 2013 1 1 544 545 -1 1004 1022 -18 B6 725 N804JB JFK

5 2013 1 1 554 600 -6 812 837 -25 DL 461 N668DN LGA

6 2013 1 1 554 558 -4 740 728 12 UA 1696 N39463 EWR

7 2013 1 1 555 600 -5 913 854 19 B6 507 N516JB EWR

8 2013 1 1 557 600 -3 709 723 -14 EV 5708 N829AS LGA

9 2013 1 1 557 600 -3 838 846 -8 B6 79 N593JB JFK

10 2013 1 1 558 600 -2 753 745 8 AA 301 N3ALAA LGA

# ℹ 336,766 more rows

# ℹ 6 more variables: dest <chr>, air_time <dbl>, distance <dbl>, hour <dbl>, minute <dbl>, time_hour <dttm>

# ℹ Use `print(n = ...)` to see more rows

​

​

​

​

• data size
• variable type
• view(flights)

Basics

1. The first argument is always a data frame.
2. The subsequent arguments typically describe which columns to operate on, using the variable names (without quotes).
3. The output is always a new data frame.

​

flights |>

filter(dest == "IAH") |>

group_by(year, month, day) |>

summarize(

arr_delay = mean(arr_delay, na.rm = TRUE)

)

Rows

• filter()
• arrange()
• distinct()

filter()

flights |>

filter(dep_delay > 120)

#> # A tibble: 9,723 × 19

#> year month day dep_time sched_dep_time dep_delay arr_time sched_arr_time

#> <int> <int> <int> <int> <int> <dbl> <int> <int>

#> 1 2013 1 1 848 1835 853 1001 1950

#> 2 2013 1 1 957 733 144 1056 853

#> 3 2013 1 1 1114 900 134 1447 1222

#> 4 2013 1 1 1540 1338 122 2020 1825

#> 5 2013 1 1 1815 1325 290 2120 1542

#> 6 2013 1 1 1842 1422 260 1958 1535

#> # ℹ 9,717 more rows

#> # ℹ 11 more variables: arr_delay <dbl>, carrier <chr>, flight <int>, …

filter()

flights |>

filter(month == 1 & day == 1)

#> # A tibble: 842 × 19

#> year month day dep_time sched_dep_time dep_delay arr_time sched_arr_time

#> <int> <int> <int> <int> <int> <dbl> <int> <int>

#> 1 2013 1 1 517 515 2 830 819

#> 2 2013 1 1 533 529 4 850 830

#> 3 2013 1 1 542 540 2 923 850

#> 4 2013 1 1 544 545 -1 1004 1022

#> 5 2013 1 1 554 600 -6 812 837

#> 6 2013 1 1 554 558 -4 740 728

#> # ℹ 836 more rows

#> # ℹ 11 more variables: arr_delay <dbl>, carrier <chr>, flight <int>, …

filter()

flights |>

filter(month == 1 | month == 2)

#> # A tibble: 51,955 × 19

#> year month day dep_time sched_dep_time dep_delay arr_time sched_arr_time

#> <int> <int> <int> <int> <int> <dbl> <int> <int>

#> 1 2013 1 1 517 515 2 830 819

#> 2 2013 1 1 533 529 4 850 830

#> 3 2013 1 1 542 540 2 923 850

#> 4 2013 1 1 544 545 -1 1004 1022

#> 5 2013 1 1 554 600 -6 812 837

#> 6 2013 1 1 554 558 -4 740 728

#> # ℹ 51,949 more rows

#> # ℹ 11 more variables: arr_delay <dbl>, carrier <chr>, flight <int>, …

filter()

flights |>

filter(month %in% c(1, 2))

#> # A tibble: 51,955 × 19

#> year month day dep_time sched_dep_time dep_delay arr_time sched_arr_time

#> <int> <int> <int> <int> <int> <dbl> <int> <int>

#> 1 2013 1 1 517 515 2 830 819

#> 2 2013 1 1 533 529 4 850 830

#> 3 2013 1 1 542 540 2 923 850

#> 4 2013 1 1 544 545 -1 1004 1022

#> 5 2013 1 1 554 600 -6 812 837

#> 6 2013 1 1 554 558 -4 740 728

#> # ℹ 51,949 more rows

#> # ℹ 11 more variables: arr_delay <dbl>, carrier <chr>, flight <int>, …

Common mistakes

flights |>

filter(month = 1)

​

​

flights |>

filter(month == 1 | 2)

arrange()

flights |>

arrange(year, month, day, dep_time)

#> # A tibble: 336,776 × 19

#> year month day dep_time sched_dep_time dep_delay arr_time sched_arr_time

#> <int> <int> <int> <int> <int> <dbl> <int> <int>

#> 1 2013 1 1 517 515 2 830 819

#> 2 2013 1 1 533 529 4 850 830

#> 3 2013 1 1 542 540 2 923 850

#> 4 2013 1 1 544 545 -1 1004 1022

#> 5 2013 1 1 554 600 -6 812 837

#> 6 2013 1 1 554 558 -4 740 728

#> # ℹ 336,770 more rows

#> # ℹ 11 more variables: arr_delay <dbl>, carrier <chr>, flight <int>, …

arrange()

flights |>

arrange(desc(dep_delay))

#> # A tibble: 336,776 × 19

#> year month day dep_time sched_dep_time dep_delay arr_time sched_arr_time

#> <int> <int> <int> <int> <int> <dbl> <int> <int>

#> 1 2013 1 9 641 900 1301 1242 1530

#> 2 2013 6 15 1432 1935 1137 1607 2120

#> 3 2013 1 10 1121 1635 1126 1239 1810

#> 4 2013 9 20 1139 1845 1014 1457 2210

#> 5 2013 7 22 845 1600 1005 1044 1815

#> 6 2013 4 10 1100 1900 960 1342 2211

#> # ℹ 336,770 more rows

#> # ℹ 11 more variables: arr_delay <dbl>, carrier <chr>, flight <int>, …

distinct()

flights |>

distinct()

#> # A tibble: 336,776 × 19

#> year month day dep_time sched_dep_time dep_delay arr_time sched_arr_time

#> <int> <int> <int> <int> <int> <dbl> <int> <int>

#> 1 2013 1 1 517 515 2 830 819

#> 2 2013 1 1 533 529 4 850 830

#> 3 2013 1 1 542 540 2 923 850

#> 4 2013 1 1 544 545 -1 1004 1022

#> 5 2013 1 1 554 600 -6 812 837

#> 6 2013 1 1 554 558 -4 740 728

#> # ℹ 336,770 more rows

#> # ℹ 11 more variables: arr_delay <dbl>, carrier <chr>, flight <int>, …

distinct()

​

flights |>

distinct(origin, dest)

#> # A tibble: 224 × 2

#> origin dest

#> <chr> <chr>

#> 1 EWR IAH

#> 2 LGA IAH

#> 3 JFK MIA

#> 4 JFK BQN

#> 5 LGA ATL

#> 6 EWR ORD

#> # ℹ 218 more rows

distinct()

flights |>

distinct(origin, dest, .keep_all = TRUE)

#> # A tibble: 224 × 19

#> year month day dep_time sched_dep_time dep_delay arr_time sched_arr_time

#> <int> <int> <int> <int> <int> <dbl> <int> <int>

#> 1 2013 1 1 517 515 2 830 819

#> 2 2013 1 1 533 529 4 850 830

#> 3 2013 1 1 542 540 2 923 850

#> 4 2013 1 1 544 545 -1 1004 1022

#> 5 2013 1 1 554 600 -6 812 837

#> 6 2013 1 1 554 558 -4 740 728

#> # ℹ 218 more rows

#> # ℹ 11 more variables: arr_delay <dbl>, carrier <chr>, flight <int>, …

count()

flights |>

count(origin, dest, sort = TRUE)

#> # A tibble: 224 × 3

#> origin dest n

#> <chr> <chr> <int>

#> 1 JFK LAX 11262

#> 2 LGA ATL 10263

#> 3 LGA ORD 8857

#> 4 JFK SFO 8204

#> 5 LGA CLT 6168

#> 6 EWR ORD 6100

#> # ℹ 218 more rows

Columns

• mutate()
• select()
• rename()
• relocate()

mutate()

flights |>

mutate(

gain = dep_delay - arr_delay,

speed = distance / air_time * 60

)

#> # A tibble: 336,776 × 21

#> year month day dep_time sched_dep_time dep_delay arr_time sched_arr_time

#> <int> <int> <int> <int> <int> <dbl> <int> <int>

#> 1 2013 1 1 517 515 2 830 819

#> 2 2013 1 1 533 529 4 850 830

#> 3 2013 1 1 542 540 2 923 850

#> 4 2013 1 1 544 545 -1 1004 1022

#> 5 2013 1 1 554 600 -6 812 837

#> 6 2013 1 1 554 558 -4 740 728

#> # ℹ 336,770 more rows

#> # ℹ 13 more variables: arr_delay <dbl>, carrier <chr>, flight <int>, …

mutate()

flights |>

mutate(

gain = dep_delay - arr_delay,

speed = distance / air_time * 60,

.before = 1

)

#> # A tibble: 336,776 × 21

#> gain speed year month day dep_time sched_dep_time dep_delay arr_time

#> <dbl> <dbl> <int> <int> <int> <int> <int> <dbl> <int>

#> 1 -9 370. 2013 1 1 517 515 2 830

#> 2 -16 374. 2013 1 1 533 529 4 850

#> 3 -31 408. 2013 1 1 542 540 2 923

#> 4 17 517. 2013 1 1 544 545 -1 1004

#> 5 19 394. 2013 1 1 554 600 -6 812

#> 6 -16 288. 2013 1 1 554 558 -4 740

#> # ℹ 336,770 more rows

#> # ℹ 12 more variables: sched_arr_time <int>, arr_delay <dbl>, …

mutate()

flights |>

mutate(

gain = dep_delay - arr_delay,

speed = distance / air_time * 60,

.after = day

)

mutate()

flights |>

mutate(

gain = dep_delay - arr_delay,

hours = air_time / 60,

gain_per_hour = gain / hours,

.keep = "used"

)

select()

flights |>

select(year, month, day)

​

flights |>

select(year:day)

​

flights |>

select(!year:day)

​

select()

flights |>

select(where(is.character))

select()

flights |>

select(tail_num = tailnum)

#> # A tibble: 336,776 × 1

#> tail_num

#> <chr>

#> 1 N14228

#> 2 N24211

#> 3 N619AA

#> 4 N804JB

#> 5 N668DN

#> 6 N39463

#> # ℹ 336,770 more rows

rename()

flights |>

rename(tail_num = tailnum)

#> # A tibble: 336,776 × 19

#> year month day dep_time sched_dep_time dep_delay arr_time sched_arr_time

#> <int> <int> <int> <int> <int> <dbl> <int> <int>

#> 1 2013 1 1 517 515 2 830 819

#> 2 2013 1 1 533 529 4 850 830

#> 3 2013 1 1 542 540 2 923 850

#> 4 2013 1 1 544 545 -1 1004 1022

#> 5 2013 1 1 554 600 -6 812 837

#> 6 2013 1 1 554 558 -4 740 728

#> # ℹ 336,770 more rows

#> # ℹ 11 more variables: arr_delay <dbl>, carrier <chr>, flight <int>, …

relocate()

flights |>

relocate(time_hour, air_time)

#> # A tibble: 336,776 × 19

#> time_hour air_time year month day dep_time sched_dep_time

#> <dttm> <dbl> <int> <int> <int> <int> <int>

#> 1 2013-01-01 05:00:00 227 2013 1 1 517 515

#> 2 2013-01-01 05:00:00 227 2013 1 1 533 529

#> 3 2013-01-01 05:00:00 160 2013 1 1 542 540

#> 4 2013-01-01 05:00:00 183 2013 1 1 544 545

#> 5 2013-01-01 06:00:00 116 2013 1 1 554 600

#> 6 2013-01-01 05:00:00 150 2013 1 1 554 558

#> # ℹ 336,770 more rows

#> # ℹ 12 more variables: dep_delay <dbl>, arr_time <int>, …

relocate()

flights |>

relocate(year:dep_time, .after = time_hour)

​

flights |>

relocate(starts_with("arr"), .before = dep_time)

Groups

• group_by()
• summarize()

group_by()

flights |>

group_by(month)

#> # A tibble: 336,776 × 19

#> # Groups: month [12]

#> year month day dep_time sched_dep_time dep_delay arr_time sched_arr_time

#> <int> <int> <int> <int> <int> <dbl> <int> <int>

#> 1 2013 1 1 517 515 2 830 819

#> 2 2013 1 1 533 529 4 850 830

#> 3 2013 1 1 542 540 2 923 850

#> 4 2013 1 1 544 545 -1 1004 1022

#> 5 2013 1 1 554 600 -6 812 837

#> 6 2013 1 1 554 558 -4 740 728

#> # ℹ 336,770 more rows

#> # ℹ 11 more variables: arr_delay <dbl>, carrier <chr>, flight <int>, …

group_by() + summarize()

flights |>

group_by(month) |>

summarize(

avg_delay = mean(dep_delay)

)

#> # A tibble: 12 × 2

#> month avg_delay

#> <int> <dbl>

#> 1 1 NA

#> 2 2 NA

#> 3 3 NA

#> 4 4 NA

#> 5 5 NA

#> 6 6 NA

#> # ℹ 6 more rows

group_by() + summarize()

flights |>

group_by(month) |>

summarize(

avg_delay = mean(dep_delay, na.rm = TRUE)

)

#> # A tibble: 12 × 2

#> month avg_delay

#> <int> <dbl>

#> 1 1 10.0

#> 2 2 10.8

#> 3 3 13.2

#> 4 4 13.9

#> 5 5 13.0

#> 6 6 20.8

#> # ℹ 6 more rows

group_by() + summarize()

flights |>

group_by(month) |>

summarize(

avg_delay = mean(dep_delay, na.rm = TRUE),

n = n()

)

#> # A tibble: 12 × 3

#> month avg_delay n

#> <int> <dbl> <int>

#> 1 1 10.0 27004

#> 2 2 10.8 24951

#> 3 3 13.2 28834

#> 4 4 13.9 28330

#> 5 5 13.0 28796

#> 6 6 20.8 28243

#> # ℹ 6 more rows

The slice_ functions

• df |> slice_head(n = 1) takes the first row from each group.
• df |> slice_tail(n = 1) takes the last row in each group.
• df |> slice_min(x, n = 1) takes the row with the smallest value of column x.
• df |> slice_max(x, n = 1) takes the row with the largest value of column x.
• df |> slice_sample(n = 1) takes one random row.

​

group_by() + slice_max()

flights |>

group_by(dest) |>

slice_max(arr_delay, n = 1) |>

relocate(dest)

#> # A tibble: 108 × 19

#> # Groups: dest [105]

#> dest year month day dep_time sched_dep_time dep_delay arr_time

#> <chr> <int> <int> <int> <int> <int> <dbl> <int>

#> 1 ABQ 2013 7 22 2145 2007 98 132

#> 2 ACK 2013 7 23 1139 800 219 1250

#> 3 ALB 2013 1 25 123 2000 323 229

#> 4 ANC 2013 8 17 1740 1625 75 2042

#> 5 ATL 2013 7 22 2257 759 898 121

#> 6 AUS 2013 7 10 2056 1505 351 2347

#> # ℹ 102 more rows

#> # ℹ 11 more variables: sched_arr_time <int>, arr_delay <dbl>, …

group_by()

daily <- flights |>

group_by(year, month, day)

daily

#> # A tibble: 336,776 × 19

#> # Groups: year, month, day [365]

#> year month day dep_time sched_dep_time dep_delay arr_time sched_arr_time

#> <int> <int> <int> <int> <int> <dbl> <int> <int>

#> 1 2013 1 1 517 515 2 830 819

#> 2 2013 1 1 533 529 4 850 830

#> 3 2013 1 1 542 540 2 923 850

#> 4 2013 1 1 544 545 -1 1004 1022

#> 5 2013 1 1 554 600 -6 812 837

#> 6 2013 1 1 554 558 -4 740 728

#> # ℹ 336,770 more rows

#> # ℹ 11 more variables: arr_delay <dbl>, carrier <chr>, flight <int>, …

summarize()

daily_flights <- daily |>

summarize(n = n())

#> `summarise()` has grouped output by 'year', 'month'. You can override using

#> the `.groups` argument.

​

daily_flights <- daily |>

summarize(

n = n(),

.groups = "drop_last"

)

ungrouping

daily |>

ungroup()

#> # A tibble: 336,776 × 19

#> year month day dep_time sched_dep_time dep_delay arr_time sched_arr_time

#> <int> <int> <int> <int> <int> <dbl> <int> <int>

#> 1 2013 1 1 517 515 2 830 819

#> 2 2013 1 1 533 529 4 850 830

#> 3 2013 1 1 542 540 2 923 850

#> 4 2013 1 1 544 545 -1 1004 1022

#> 5 2013 1 1 554 600 -6 812 837

#> 6 2013 1 1 554 558 -4 740 728

#> # ℹ 336,770 more rows

#> # ℹ 11 more variables: arr_delay <dbl>, carrier <chr>, flight <int>, …

ungroup()

daily |>

ungroup() |>

summarize(

avg_delay = mean(dep_delay, na.rm = TRUE),

flights = n()

)

#> # A tibble: 1 × 2

#> avg_delay flights

#> <dbl> <int>

#> 1 12.6 336776

Piping the APT data

dtApt.csv

​

데이터 시각화

앤스콤의 4개 데이터셋(Anscombe’s Quartet)

Visualization Representation

46

Perception replaces cognition

데이터시각화 종류

• 시간 시각화
• 막대그래프/ 누적 막대그래프
• 선 그래프/ 누적 선그래프
• 분포 시각화
• 히스토그램
• 원그래프(파이차트)/ 도넛 그래프
• 누적 선그래프
• 트리맵
• 관계 시각화
• 산점도/ 버블차트

시간 시각화: 막대그래프, 누적 막대그래프

• 값들의 뚜렷한 차이를 드러낼 수 있도록 시각화
• 막대는 높이라는 절대값을 갖는 동시에 손쉽게 비교 가능
• 가로축에는 시간, 세로축에는 시간 별 값으로 표현
• 누적 막대그래프는 한 구간에 세부적으로 분류된 항복들이 존재

시간 시각화: 선그래프

• 선으로 표현된 연속적인 데이터 표현
• 변화하는 변수 추이 파악이 용이

분포 시각화: 히스토그램

• 연속형 변수의 분포를 시각화하기 위해 사용
• 변수를 임의로 구간으로 나누고 각 구간에 포함되는 관측치의 빈도를 계산

분포 시각화: 원그래프

• 전체에서 부분이 차지하는 비율을 시각화
• 내용설명을 위한 텍스트와 비율 포함
• 총합을 100%으로 나타내고 각 항목들의 분포가 상대적 비중으로 표시됨

분포 시각화: 누적연속그래프

• 여러개의 시계열 그래프를 축적
• 가로축은 시간, 세로축은 분포
• 한 시점의 세로 단면은 그 시점의 분포를 나타냄

​

분포 시각화: 트리맵

• 각 사각형의 크기가 해당 항목의 비중을 나타냄
• 바깥 사각형은 대분류, 내부 사각형은 세부 분류를 의미함
• 위계구조나 트리구조의 데이터를 표시할 때 활용

관계 시각화: 산점도

• 두 변수를 쌍으로 묶어 좌표평면에 표시하여 관계를 파악
• 점들이 오른쪽 위, 왼쪽 아래에 집중되어 있으면 양의 상관관계
• 점들이 오른쪽 아래, 왼쪽 위에 집중되어 있으면 음의 상관관계
• 세개 이상의 변수들 관계를 볼 때는 버블차트 이용

데이터시각화 고전 예: 나폴레옹 진군 맵

데이터시각화 예: 1854년 런던 콜레라 발병 맵

데이터시각화 예: 크림 전쟁 사망원인

데이터시각화 최근 예: 인스타그램 공간 분석

김은택, 김정빈, & 금경조. (2019). 인스타그램 위치정보 데이터를 이용한 을지로 3·4가 지역 활성화의 실증분석. 서울도시연구, 20(2), 19–35.

Pandemic and Data Viz

https://blogs.sas.com/content/sascom/2020/03/10/using-data-visualization-to-track-the-coronavirus-outbreak/

Government Service and Data Viz

Government Service and Data Viz

Platform and Data Viz

Real Estate and Data Viz

FinTech and Data Viz

Fitness App and Data Viz

참고자료

• Data visualization
• Plotly Dash App Examples
• Data Is Beautiful: 10 Of The Best Data Visualization Examples From History & Today
• 8 Most-Favorited Data Visualizations on Tableau Public
• Computational modeling (neural networks)
• Neural Network 3D Simulation
• 3Blue1Brown - YouTube

​

R을 활용한 데이터 시각화 실습과 응용

https://r-graph-gallery.com/best-dataviz-packages.html

​

ggplot2 materials

https://ggplot2.tidyverse.org/index.html

https://r-graphics.org/

https://ggplot2-book.org/

​

​

​

RStudio

2일차

https://drive.google.com/drive/folders/1GpfInPRZPycRE2qz_yMX7G5TfJAQsLH6

​

​

First steps

library(ggplot2)

mpg

#> # A tibble: 234 × 11

#> manufacturer model displ year cyl trans drv cty hwy fl class

#> <chr> <chr> <dbl> <int> <int> <chr> <chr> <int> <int> <chr> <chr>

#> 1 audi a4 1.8 1999 4 auto(l5) f 18 29 p compa…

#> 2 audi a4 1.8 1999 4 manual(m5) f 21 29 p compa…

#> 3 audi a4 2 2008 4 manual(m6) f 20 31 p compa…

#> 4 audi a4 2 2008 4 auto(av) f 21 30 p compa…

#> 5 audi a4 2.8 1999 6 auto(l5) f 16 26 p compa…

#> 6 audi a4 2.8 1999 6 manual(m5) f 18 26 p compa…

#> # ℹ 228 more rows

Key components: data, aes, geom function

ggplot(mpg, aes(x = displ, y = hwy)) +

geom_point()

Colour, size, shape and other aesthetic attributes

ggplot(mpg, aes(displ, hwy, colour = class)) +

geom_point()

Faceting

ggplot(mpg, aes(displ, hwy)) +

geom_point() +

facet_wrap(~class)

Plot geoms

geom_smooth() fits a smoother to the data and displays the smooth and its standard error.

geom_boxplot() produces a box-and-whisker plot to summarise the distribution of a set of points.

geom_histogram() and geom_freqpoly() show the distribution of continuous variables.

geom_bar() shows the distribution of categorical variables.

geom_path() and geom_line() draw lines between the data points.

A line plot is constrained to produce lines that travel from left to right, while paths can go in any direction.

Lines are typically used to explore how things change over time.

​

Adding a smoother to a plot

ggplot(mpg, aes(displ, hwy)) +

geom_point() +

geom_smooth()

​

geom_smooth

method = "loess", the default for small n, uses a smooth local regression (as described in ?loess).

The wiggliness of the line is controlled by the span parameter, which ranges from 0 (exceedingly wiggly) to 1 (not so wiggly).

​

​

ggplot(mpg, aes(displ, hwy)) +

geom_point() +

geom_smooth(span = 0.2)

​

ggplot(mpg, aes(displ, hwy)) +

geom_point() +

geom_smooth(span = 1)

​

method = "lm"

ggplot(mpg, aes(displ, hwy)) +

geom_point() +

geom_smooth(method = "lm")

#> `geom_smooth()` using formula = 'y ~ x'

Boxplots and jittered points

ggplot(mpg, aes(drv, hwy)) +

geom_point()

jitter, boxplot, violin

ggplot(mpg, aes(drv, hwy)) + geom_jitter()

ggplot(mpg, aes(drv, hwy)) + geom_boxplot()

ggplot(mpg, aes(drv, hwy)) + geom_violin()

Histograms and frequency polygons

ggplot(mpg, aes(hwy)) +

geom_histogram()

ggplot(mpg, aes(hwy)) +

geom_freqpoly()

​

Histograms and frequency polygons

ggplot(mpg, aes(hwy)) +

geom_freqpoly(binwidth = 2.5)

ggplot(mpg, aes(hwy)) +

geom_freqpoly(binwidth = 1)

Histograms and frequency polygons

ggplot(mpg, aes(displ, colour = drv)) +

geom_freqpoly(binwidth = 0.5)

ggplot(mpg, aes(displ, fill = drv)) +

geom_histogram(binwidth = 0.5) +

facet_wrap(~drv, ncol = 1)

Bar Chart

ggplot(mpg, aes(manufacturer)) +

geom_bar()

Bar chart from presummarized data

drugs <- data.frame(

drug = c("a", "b", "c"),

effect = c(4.2, 9.7, 6.1)

)

ggplot(drugs, aes(drug, effect)) + geom_bar(stat = "identity")

ggplot(drugs, aes(drug, effect)) + geom_point()

Time series with line and path plots

ggplot(economics, aes(date, unemploy / pop)) +

geom_line()

ggplot(economics, aes(date, uempmed)) +

geom_line()

Time series with line and path plots

ggplot(economics, aes(unemploy / pop, uempmed)) +

geom_path() +

geom_point()

​

year <- function(x) as.POSIXlt(x)$year + 1900

ggplot(economics, aes(unemploy / pop, uempmed)) +

geom_path(colour = "grey50") +

geom_point(aes(colour = year(date)))

Output

p <- ggplot(mpg, aes(displ, hwy, colour = factor(cyl))) +

geom_point()

print(p)

# Save png to disk

ggsave("plot.png", p, width = 5, height = 5)

Layers

• ggplot use a layered structure to display the data or a statistical summary, and add additional metadata
• Different components
• individual geoms
• collective geoms
• statistical summaries
• maps
• networks
• annotations
• arranging plots

​

Basic plot types: Individual geoms

• These geoms is two dimensional and requires both x and y aesthetics.
• All of them understand colour (or color) and size aesthetics, and the filled geoms (bar, tile and polygon) also understand fill.
• geom_area()
• geom_bar(stat = "identity")
• geom_line()
• geom_point()
• geom_polygon()
• geom_rect(), geom_tile() and geom_raster()
• geom_text()

geom_point, geom_text, geom_bar, geom_tile

df <- data.frame(

x = c(3, 1, 5),

y = c(2, 4, 6),

label = c("a","b","c")

)

p <- ggplot(df, aes(x, y, label = label)) +

labs(x = NULL, y = NULL) + # Hide axis label

theme(plot.title = element_text(size = 12)) # Shrink plot title

p + geom_point() + ggtitle("point")

p + geom_text() + ggtitle("text")

p + geom_bar(stat = "identity") + ggtitle("bar")

p + geom_tile() + ggtitle("raster")

geom_point, geom_text, geom_bar, geom_tile

geom_line, geom_area, geom_path, geom_polygon

p + geom_line() + ggtitle("line")

p + geom_area() + ggtitle("area")

p + geom_path() + ggtitle("path")

p + geom_polygon() + ggtitle("polygon")

geom_line, geom_area, geom_path, geom_polygon

Multiple observations with one geom: Collective geoms

​

​

data(Oxboys, package = "nlme")

head(Oxboys)

#> Subject age height Occasion

#> 1 1 -1.0000 140 1

#> 2 1 -0.7479 143 2

#> 3 1 -0.4630 145 3

#> 4 1 -0.1643 147 4

#> 5 1 -0.0027 148 5

#> 6 1 0.2466 150 6

Multiple groups, one aesthetic

ggplot(Oxboys, aes(age, height, group = Subject)) +

geom_point() +

geom_line()

without group specification

ggplot(Oxboys, aes(age, height)) +

geom_point() +

geom_line()

Different groups on different layers

ggplot(Oxboys, aes(age, height, group = Subject)) +

geom_line() +

geom_smooth(method = "lm", se = FALSE)

​

Different groups on different layers

ggplot(Oxboys, aes(age, height)) +

geom_line(aes(group = Subject)) +

geom_smooth(method = "lm", linewidth = 2, se = FALSE)

geom_boxplot() + geom_line()

ggplot(Oxboys, aes(Occasion, height)) +

geom_boxplot() +

geom_line(colour = "#3366FF", alpha = 0.5)

geom_boxplot() + geom_line()

ggplot(Oxboys, aes(Occasion, height)) +

geom_boxplot() +

geom_line(aes(group = Subject), colour = "#3366FF", alpha = 0.5)

geom_line() + geom_point()

df <- data.frame(x = 1:3, y = 1:3, colour = c(1, 3, 5))

​

ggplot(df, aes(x, y, colour = factor(colour))) +

geom_line(aes(group = 1), linewidth = 2) +

geom_point(size = 5)

​

ggplot(df, aes(x, y, colour = colour)) +

geom_line(aes(group = 1), linewidth = 2) +

geom_point(size = 5)

geom_line() + geom_point()

xgrid <- with(df, seq(min(x), max(x), length = 50))

interp <- data.frame(

x = xgrid,

y = approx(df$x, df$y, xout = xgrid)$y,

colour = approx(df$x, df$colour, xout = xgrid)$y

)

ggplot(interp, aes(x, y, colour = colour)) +

geom_line(linewidth = 2) +

geom_point(data = df, size = 5)

geom_bar()

​

ggplot(mpg, aes(class)) +

geom_bar()

ggplot(mpg, aes(class, fill = drv)) +

geom_bar()

geom_bar()

ggplot(mpg, aes(class, fill = hwy)) +

geom_bar()

ggplot(mpg, aes(class, fill = hwy, group = hwy)) +

geom_bar()

Statistical summaries

• Discrete x, range: geom_errorbar(), geom_linerange()
• Discrete x, range & center: geom_crossbar(), geom_pointrange()
• Continuous x, range: geom_ribbon()
• Continuous x, range & center: geom_smooth(stat = "identity")

geom_crossbar(), geom_pointrange(), geom_smooth()

y <- c(18, 11, 16)

df <- data.frame(x = 1:3, y = y, se = c(1.2, 0.5, 1.0))

​

base <- ggplot(df, aes(x, y, ymin = y - se, ymax = y + se))

base + geom_crossbar()

base + geom_pointrange()

base + geom_smooth(stat = "identity")

geom_errorbar(), geom_linerange(), geom_ribbon()

​

base + geom_errorbar()

base + geom_linerange()

base + geom_ribbon()

Weighted data

ggplot(midwest, aes(percwhite, percbelowpoverty)) + geom_point()

ggplot(midwest, aes(percwhite, percbelowpoverty)) +

geom_point(aes(size = poptotal / 1e6)) + # Weight by population

scale_size_area("Population\n(millions)", breaks = c(0.5, 1, 2, 4))

Weighted data

ggplot(midwest, aes(percwhite, percbelowpoverty)) +

geom_point() +

geom_smooth(method = lm, linewidth = 1)

ggplot(midwest, aes(percwhite, percbelowpoverty)) +

geom_point(aes(size = poptotal / 1e6)) +

geom_smooth(aes(weight = poptotal), method = lm, linewidth = 1) +

scale_size_area(guide = "none")

​

Weighted data

ggplot(midwest, aes(percbelowpoverty)) +

geom_histogram(binwidth = 1) +

ylab("Counties")

ggplot(midwest, aes(percbelowpoverty)) +

geom_histogram(aes(weight = poptotal), binwidth = 1) +

ylab("Population (1000s)")

Displaying distributions

ggplot(diamonds, aes(depth)) +

geom_histogram()

ggplot(diamonds, aes(depth)) +

geom_histogram(binwidth = 0.1) +

xlim(55, 70)

​

Displaying distributions

ggplot(diamonds, aes(depth)) +

geom_freqpoly(aes(colour = cut), binwidth = 0.1, na.rm = TRUE) +

xlim(58, 68) +

theme(legend.position = "none")

​

ggplot(diamonds, aes(depth)) +

geom_histogram(aes(fill = cut), binwidth = 0.1, position = "fill", na.rm = TRUE) +

xlim(58, 68) +

theme(legend.position = "none")

Displaying distributions

ggplot(diamonds, aes(depth)) +

geom_density(na.rm = TRUE) + xlim(58, 68) + theme(legend.position = "none")

​

ggplot(diamonds, aes(depth, fill = cut, colour = cut)) +

geom_density(alpha = 0.2, na.rm = TRUE) + xlim(58, 68) + theme(legend.position = "none")

geom_boxplot()

ggplot(diamonds, aes(clarity, depth)) +

geom_boxplot()

​

ggplot(diamonds, aes(carat, depth)) +

geom_boxplot(aes(group = cut_width(carat, 0.1))) +

xlim(NA, 2.05)

​

geom_violin()

ggplot(diamonds, aes(clarity, depth)) +

geom_violin()

​

ggplot(diamonds, aes(carat, depth)) +

geom_violin(aes(group = cut_width(carat, 0.1))) +

xlim(NA, 2.05)

Dealing with overplotting

​

​

df <- data.frame(x = rnorm(2000), y = rnorm(2000))

norm <- ggplot(df, aes(x, y)) + xlab(NULL) + ylab(NULL)

norm + geom_point()

norm + geom_point(shape = 1) # Hollow circles

norm + geom_point(shape = ".") # Pixel sized

alpha

norm + geom_point(alpha = 1 / 3)

norm + geom_point(alpha = 1 / 5)

norm + geom_point(alpha = 1 / 10)

geom_bar()

ggplot(diamonds, aes(color)) +

geom_bar()

​

ggplot(diamonds, aes(color, price)) +

geom_bar(stat = "summary_bin", fun = mean)

Annotations

Plot and axis titles

labels

font face

geom_text()

​

​

​

​

​

​

Plot and axis titles

ggplot(mpg, aes(displ, hwy)) +

geom_point(aes(colour = factor(cyl))) +

labs(

x = "Engine displacement (litres)",

y = "Highway miles per gallon",

colour = "Number of cylinders",

title = "Mileage by engine size and cylinders",

subtitle = "Source: https://fueleconomy.gov"

)

​

labels

values <- seq(from = -2, to = 2, by = .01)

df <- data.frame(x = values, y = values ^ 3)

ggplot(df, aes(x, y)) +

geom_path() +

labs(y = quote(f(x) == x^3))

font face

df <- data.frame(x = 1:3, y = 1:3)

base <- ggplot(df, aes(x, y)) +

geom_point() +

labs(x = "Axis title with *italics* and **boldface**")

​

base

base + theme(axis.title.x = ggtext::element_markdown())

geom_text()

df <- data.frame(x = 1, y = 3:1, family = c("sans", "serif", "mono"))

ggplot(df, aes(x, y)) +

geom_text(aes(label = family, family = family))

geom_text()

df <- data.frame(x = 1, y = 3:1, face = c("plain", "bold", "italic"))

ggplot(df, aes(x, y)) +

geom_text(aes(label = face, fontface = face))

​

geom_text()

df <- data.frame(

x = c(1, 1, 2, 2, 1.5),

y = c(1, 2, 1, 2, 1.5),

text = c(

"bottom-left", "top-left",

"bottom-right", "top-right", "center"

)

)

​

​

​

​

​

​

​

ggplot(df, aes(x, y)) +

geom_text(aes(label = text))

ggplot(df, aes(x, y)) +

geom_text(aes(label = text), vjust = "inward", hjust = "inward")

geom_text()

df <- data.frame(

treatment = c("a", "b", "c"),

response = c(1.2, 3.4, 2.5)

)

​

​

​

​

​

ggplot(df, aes(treatment, response)) +

geom_point() +

geom_text(

mapping = aes(label = paste0("(", response, ")")),

nudge_x = -0.3

) +

ylim(1.1, 3.6)

geom_text()

ggplot(mpg, aes(displ, hwy)) +

geom_text(aes(label = model)) +

xlim(1, 8)

​

​

​

​

​

​

​

​

​

ggplot(mpg, aes(displ, hwy)) +

geom_text(aes(label = model), check_overlap = TRUE) +

xlim(1, 8)

geom_text_repel()

mini_mpg <- mpg[sample(nrow(mpg), 20), ]

ggplot(mpg, aes(displ, hwy)) +

geom_point(colour = "red") +

ggrepel::geom_text_repel(data = mini_mpg, aes(label = class))

Building custom annotations

• geom_text() and geom_label() to add text, as illustrated earlier.
• geom_rect() to highlight interesting rectangular regions of the plot. geom_rect() has aesthetics xmin, xmax, ymin and ymax.
• geom_line(), geom_path() and geom_segment() to add lines. All these geoms have an arrow parameter, which allows you to place an arrowhead on the line. Create arrowheads with arrow(), which has arguments angle, length, ends and type.
• geom_vline(), geom_hline() and geom_abline() allow you to add reference lines (sometimes called rules), that span the full range of the plot.

​

geom_line()

ggplot(economics, aes(date, unemploy)) +

geom_line()

​

​

geom_rect(), geom_vline(), geom_text()

presidential <- subset(presidential, start > economics$date[1])

​

ggplot(economics) +

geom_rect(

aes(xmin = start, xmax = end, fill = party),

ymin = -Inf, ymax = Inf, alpha = 0.2,

data = presidential

) +

geom_vline(

aes(xintercept = as.numeric(start)),

data = presidential,

colour = "grey50", alpha = 0.5

) +

geom_text(

aes(x = start, y = 2500, label = name),

data = presidential,

size = 3, vjust = 0, hjust = 0, nudge_x = 50

) +

geom_line(aes(date, unemploy)) +

scale_fill_manual(values = c("blue", "red")) +

xlab("date") +

ylab("unemployment")

annotate()

yrng <- range(economics$unemploy)

xrng <- range(economics$date)

caption <- paste(strwrap("Unemployment rates in the US have

varied a lot over the years", 40), collapse = "\n")

​

ggplot(economics, aes(date, unemploy)) +

geom_line() +

annotate(

geom = "text", x = xrng[1], y = yrng[2],

label = caption, hjust = 0, vjust = 1, size = 4

)

annotate()

p <- ggplot(mpg, aes(displ, hwy)) +

geom_point(

data = filter(mpg, manufacturer == "subaru"),

colour = "orange",

size = 3

) +

geom_point()

​

​

​

​

​

p +

annotate(geom = "point", x = 5.5, y = 40, colour = "orange", size = 3) +

annotate(geom = "point", x = 5.5, y = 40) +

annotate(geom = "text", x = 5.6, y = 40, label = "subaru", hjust = "left")

annotate()

p +

annotate(

geom = "curve", x = 4, y = 35, xend = 2.65, yend = 27,

curvature = .3, arrow = arrow(length = unit(2, "mm"))

) +

annotate(geom = "text", x = 4.1, y = 35, label = "subaru", hjust = "left")

Direct labelling

ggplot(mpg, aes(displ, hwy, colour = class)) +

geom_point()

​

ggplot(mpg, aes(displ, hwy, colour = class)) +

geom_point(show.legend = FALSE) +

directlabels::geom_dl(aes(label = class), method = "smart.grid")

Direct labelling

ggplot(mpg, aes(displ, hwy)) +

geom_point() +

ggforce::geom_mark_ellipse(aes(label = cyl, group = cyl))

Direct labelling

data(Oxboys, package = "nlme")

ggplot(Oxboys, aes(age, height, group = Subject)) +

geom_line() +

geom_point() +

gghighlight::gghighlight(Subject %in% 1:3)

​

Annotation across facets

ggplot(diamonds, aes(log10(carat), log10(price))) +

geom_bin2d() +

facet_wrap(vars(cut), nrow = 1)

Annotation across facets

mod_coef <- coef(lm(log10(price) ~ log10(carat), data = diamonds))

ggplot(diamonds, aes(log10(carat), log10(price))) +

geom_bin2d() +

geom_abline(intercept = mod_coef[1], slope = mod_coef[2],

colour = "white", linewidth = 1) +

facet_wrap(vars(cut), nrow = 1)

Annotation across facets

ggplot(mpg, aes(displ, hwy, colour = factor(cyl))) +

geom_point() +

gghighlight::gghighlight() +

facet_wrap(vars(cyl))

Laying out plots side by side

p1 <- ggplot(mpg) +

geom_point(aes(x = displ, y = hwy))

​

p2 <- ggplot(mpg) +

geom_bar(aes(x = as.character(year), fill = drv), position = "dodge") +

labs(x = "year")

​

p3 <- ggplot(mpg) +

geom_density(aes(x = hwy, fill = drv), colour = NA) +

facet_grid(rows = vars(drv))

​

p4 <- ggplot(mpg) +

stat_summary(aes(x = drv, y = hwy, fill = drv), geom = "col", fun.data = mean_se) +

stat_summary(aes(x = drv, y = hwy), geom = "errorbar", fun.data = mean_se, width = 0.5)

library(patchwork)

library(patchwork)

p1 + p2

library(patchwork)

p1 + p2 + p3 + p4

​

​

Taking control of the layout

p1 + p2 + p3 + plot_layout(ncol = 2)

​

​

Taking control of the layout

p1 / p2

​

​

Taking control of the layout

p3 | p4

​

​

Taking control of the layout

p3 | (p2 / (p1 | p4))

​

​

Taking control of the layout

layout <- "

AAB

C#B

CDD

"

​

p1 + p2 + p3 + p4 +

plot_layout(design = layout)

Taking control of the layout

p1 + p2 + p3 + plot_layout(ncol = 2, guides = "collect")

​

​

Taking control of the layout

p1 + p2 + p3 + guide_area() + plot_layout(ncol = 2, guides = "collect")

​

​

Modifying subplots

p12 <- p1 + p2

p12[[2]] <- p12[[2]] + theme_light()

p12

Modifying subplots

p1 + p4 & theme_minimal()

​

​

Modifying subplots

p1 + p4 & scale_y_continuous(limits = c(0, 45))

​

​

Adding annotation

p34 <- p3 + p4 + plot_annotation(

title = "A closer look at the effect of drive train in cars",

caption = "Source: mpg dataset in ggplot2"

)

p34

Taking control of the layout

p34 + plot_annotation(theme = theme_gray(base_family = "mono"))

​

​

Taking control of the layout

p34 & theme_gray(base_family = "mono")

​

​

Taking control of the layout

p123 <- p1 | (p2 / p3)

p123 + plot_annotation(tag_levels = "I") # Uppercase roman numerics

Taking control of the layout

p123[[2]] <- p123[[2]] + plot_layout(tag_level = "new")

p123 + plot_annotation(tag_levels = c("I", "a"))

Arranging plots on top of each other

p1 + inset_element(p2, left = 0.5, bottom = 0.4, right = 0.9, top = 0.95)

​

​

inset_element()

p1 +

inset_element(

p2,

left = 0.4,

bottom = 0.4,

right = unit(1, "npc") - unit(15, "mm"),

top = unit(1, "npc") - unit(15, "mm"),

align_to = "full"

)

inset_element

p24 <- p2 / p4 + plot_layout(guides = "collect")

p1 + inset_element(p24, left = 0.5, bottom = 0.05, right = 0.95, top = 0.9)

inset_element

p12 <- p1 + inset_element(p2, left = 0.5, bottom = 0.5, right = 0.9, top = 0.95)

p12 & theme_bw()

plot_annotation()

p12 + plot_annotation(tag_levels = "A")

​

​

Other aesthetics

• size scales
• shape scales
• line width scales
• line type scales

Size

base <- ggplot(mpg, aes(displ, hwy, size = cyl)) +

geom_point()

​

base

base + scale_size(range = c(1, 2))

Radius size scales

planets

#> name type position radius orbit

#> 1 Mercury Inner 1 2440 5.79e+07

#> 2 Venus Inner 2 6052 1.08e+08

#> 3 Earth Inner 3 6378 1.50e+08

#> 4 Mars Inner 4 3390 2.28e+08

#> 5 Jupiter Outer 5 71400 7.78e+08

#> 6 Saturn Outer 6 60330 1.43e+09

#> 7 Uranus Outer 7 25559 2.87e+09

#> 8 Neptune Outer 8 24764 4.50e+09

scale_radius()

base <- ggplot(planets, aes(1, name, size = radius)) +

geom_point() +

scale_x_continuous(breaks = NULL) +

labs(x = NULL, y = NULL, size = NULL)

base + ggtitle("not to scale")

base +

scale_radius(limits = c(0, NA), range = c(0, 10)) +

ggtitle("to scale")

Binned size scales

base <- ggplot(mpg, aes(displ, manufacturer, size = hwy)) +

geom_point(alpha = .2) +

scale_size_binned()

base

​

Shape

base <- ggplot(mpg, aes(displ, hwy, shape = factor(cyl))) +

geom_point()

​

base

base + scale_shape(solid = FALSE)

scale_shape_manual()

base +

scale_shape_manual(

values = c("4" = 16, "5" = 17, "6" = 1 , "8" = 2)

)

​

Line width

base <- ggplot(airquality, aes(x = factor(Month), y = Temp))

​

base + geom_pointrange(stat = "summary", fun.data = "median_hilow")

base + geom_pointrange(

stat = "summary",

fun.data = "median_hilow",

size = 2

)

base + geom_pointrange(

stat = "summary",

fun.data = "median_hilow",

linewidth = 2

)

scale_linewidth()

ggplot(airquality, aes(Day, Temp, group = Month)) +

geom_line(aes(linewidth = Month)) +

scale_linewidth(range = c(0.5, 3))

​

Line type

ggplot(economics_long, aes(date, value01, linetype = variable)) +

geom_line()

시각화 자료를 활용한 사례

• 서울 인포그래픽 link
• KDI 경제e정표 link
• 기획보도 2024 수도권 청년의 삶 link

​

…

​

​

Creating graphs for APT data

dtApt.csv

​