Visualization R Notebook

【目錄】

1. GGPlot2
2. Dplyr
3. Gapminder
4. Visualization Principles

https://rafalab.github.io/dsbook/introduction-2.html

---

【GGPlot2】

Sys.setlocale("LC_ALL",'C') #清除國家偵測設定

[1] "C"

library(dslabs)    # 內建資料
library(dplyr)
library(ggplot2)
library(ggthemes)  # 套用主題
library(ggrepel)   # 標籤不重疊

GGPlot2 Cheat Sheet1

GGPlot2 Cheat Sheet2

【Basic To Know】

常用：

ggplot() +
  geom_point()       # 散布圖
  geom_line()       
  geom_bar()         # 長條圖
  geom_histogram()   # 直方圖
  geom_density()     # 機率密度圖
  geom_boxplot()    

補充：

geom_histogram(binwidth = 1)   # 決定直方圖每根寬度
scale_x_continuous(trans = "log2")   # 改變尺度

【加標籤】

geom_label(aes(label = abb))   # 把點變成標籤狀
geom_text(aes(label = abb))    # 在點上方加名稱

# 若已在ggplot裡加了label的參數,想要增加顏色只需在label裡指定
murders %>% ggplot(aes(population, total, label=abb)) +
  geom_label(color="blue")

# 若想改用region作為顏色類別,則要用aes來包起來,不然會與abb衝突
murders %>% ggplot(aes(population, total, label=abb)) +
  geom_label(aes(color=region))

【散布圖 Scatter Diagram】

gapminder_Africa_2010 <- gapminder %>%
    filter(continent == "Africa" & year == 2010 & !is.na(gdp)) %>%
    mutate(dollars_per_day = gdp/population/365)
gapminder_Africa_2010 %>%
    ggplot(aes(dollars_per_day, infant_mortality, color = region)) +
    geom_point() +
    scale_x_continuous(trans = "log2") +
    geom_text(aes(label = country)) +
    facet_grid(.~year)

【機率密度圖 Density】

heights %>% 
  ggplot(aes(height)) +
  geom_density(aes(group=sex))

heights %>% 
  ggplot(aes(height, color = sex)) +    # 以color直接取代group
  geom_density()                        # color是線(外框)的顏色

heights %>% 
  ggplot(aes(height, fill = sex)) +     # fill是填滿顏色
  geom_density(alpha = 0.2)             # alpha用來調整透明度

daydollars <- gapminder %>%
    filter(continent == "Africa" & year %in% c(1970,2010) & !is.na(gdp)) %>%
    mutate(dollars_per_day = gdp/population/365)
daydollars %>%
    ggplot(aes(dollars_per_day, fill = region)) +    # fill看所有region的密度分布
    geom_density(alpha = 0.2, bw = 0.5, position = "stack") +    # bw是平滑的程度(常態/心電圖那樣的陡) # 用stack疊各region
    scale_x_continuous(trans = "log2") +
    facet_grid(.~year)    # 左右並排

gapminder  %>%
    filter(continent == "Africa" & year %in% c(1970,2010) & !is.na(gdp) & !is.na(year) & !is.na(infant_mortality)) %>%
    mutate(dollars_per_day = gdp/population/365) %>%
    ggplot(aes(dollars_per_day, infant_mortality, color = region)) +
    geom_point() +
    scale_x_continuous(trans = "log2") +
    geom_text(aes(label = country)) +
    facet_grid(year~.)    # 上下並排

【分位圖 qq-plot】

p <- heights %>% filter(sex=="Male") %>%
  ggplot(aes(sample = height)) 
params <- heights %>% filter(sex=="Male") %>%
  summarize(mean = mean(height), sd = sd(height))
p  +  geom_qq(dparams = params)

heights %>% 
  filter(sex=="Male") %>%
  ggplot(aes(sample = scale(height))) + 
  geom_qq() +
  geom_abline()

【箱形圖 Boxplot】

murders %>% mutate(rate = total/population*100000) %>% 
    mutate(region = reorder(region, rate, FUN = median)) %>%
    ggplot(aes(region,rate)) +
    geom_boxplot() +
    geom_point() +    # boxplot加上線上的觀察點
    geom_jitter(width = 0.1, alpha = 0.2)    # 線外的觀察點(分布樣態)

Warning message:
In strsplit(code, "\n", fixed = TRUE) :
  input string 1 is invalid in this locale

【Comparing Distribution】

facet_grid(year ~ group) # 兩張圖排在一起 # 前者:上下;後者:左右
geom_boxplot(aes(region,dollars_per_day, fill = facor(year)))

範例：

daydollars <- gapminder %>%
    filter(continent == "Africa" & year %in% c(1970,2010) & !is.na(gdp)) %>%
    mutate(dollars_per_day = gdp/population/365)
daydollars %>%
    ggplot(aes(dollars_per_day)) +
    geom_density() +
    scale_x_continuous(trans = "log2") +
    facet_grid(.~year) 

【調整技巧】

重新排序(default is alphabetical)

region = factor(c("Asia","Asia","West","West","West"))
levels(region)

[1] "Asia" "West"

value = c(10, 11, 12, 6, 4)
region = reorder(region, value, FUN = mean)
levels(region)

[1] "West" "Asia"

mutate(region = reorder(region, value, FUN = median))
mutate(group = factor(group, levels = c("Others", "Latin America", "East Asia")))

【美觀技巧】

themes_economist()  # 背景主題
themes_fivethirtyeight()  # 背景主題
geom_text_repel()  # 讓圖表上的各點標籤不互相重疊
theme(axis.text.x = element_text(angle = 30, hjust = 1)) # 旋轉x軸標籤使之不重疊且好閱讀

範例：

# First define the slope of line
r = murders %>% summarize(rate = sum(total)/sum(population)*10^6) %>% .$rate
# Make the plot
murders %>% ggplot(aes(population/10^6, total, label=abb)) +
  geom_abline(intercept = log10(r), lty = 2, color = "darkgrey") +
  geom_point(aes(col=region), size = 3) +
  geom_text_repel() +
  scale_x_log10() + scale_y_log10() +
  xlab("Population in millions (log scale)") + ylab("Total number of murders (log scale)") +
  ggtitle("US Gun Murders in US 2010") +
  scale_color_discrete(name = "Region") +
  theme_economist()

---

【Dplyr】

【處理資料】

mean(na_example, na.rm = TRUE)     # 移除NA
!is.na(gdp)                        # 移除NA
X$a = NULL                         # 移除column

library(dplyr)
library(NHANES)
data(NHANES)
ref_avg <- NHANES %>%
  filter(AgeDecade == " 20-29" & Gender == "female") %>%  # 篩選要分析的觀察值
  summarize(average = mean(BPSysAve, na.rm = TRUE), 
            standard_deviation = sd(BPSysAve, na.rm=TRUE))  # 在ref_avg底下製作多個column
ref_avg

# A tibble: 1 x 2
  average standard_deviation
    <dbl>              <dbl>
1    108.               10.1

ref_avg %>% .$average  # 因為回傳只有單值, 將table轉換成numeric

[1] 108.4224

NHANES %>%
      group_by(AgeDecade, Gender) %>%
      summarize(average = mean(BPSysAve, na.rm = TRUE), 
      standard_deviation = sd(BPSysAve, na.rm = TRUE))

# 使用group_by可以輸出每個分類的值

NHANES %>% top_n(10, BPSys1)

# A tibble: 14 x 76
      ID SurveyYr Gender   Age AgeDecade AgeMonths Race1    Race3
   <int> <fct>    <fct>  <int> <fct>         <int> <fct>    <fct>
 1 53371 2009_10  male      68 " 60-69"        817 White    NA   
 2 55311 2009_10  female    55 " 50-59"        671 Hispanic NA   
 3 65296 2011_12  male      80 NA               NA White    White
 4 65296 2011_12  male      80 NA               NA White    White
 5 65475 2011_12  female    44 " 40-49"         NA Black    Black
 6 66873 2011_12  female    54 " 50-59"         NA White    White
 7 66873 2011_12  female    54 " 50-59"         NA White    White
 8 67957 2011_12  male      50 " 50-59"         NA Black    Black
 9 67957 2011_12  male      50 " 50-59"         NA Black    Black
10 68301 2011_12  male      59 " 50-59"         NA White    White
11 68301 2011_12  male      59 " 50-59"         NA White    White
12 68301 2011_12  male      59 " 50-59"         NA White    White
13 68301 2011_12  male      59 " 50-59"         NA White    White
14 68301 2011_12  male      59 " 50-59"         NA White    White
# ... with 68 more variables: Education <fct>, MaritalStatus <fct>,
#   HHIncome <fct>, HHIncomeMid <int>, Poverty <dbl>,
#   HomeRooms <int>, HomeOwn <fct>, Work <fct>, Weight <dbl>,
#   Length <dbl>, HeadCirc <dbl>, Height <dbl>, BMI <dbl>,
#   BMICatUnder20yrs <fct>, BMI_WHO <fct>, Pulse <int>,
#   BPSysAve <int>, BPDiaAve <int>, BPSys1 <int>, BPDia1 <int>,
#   BPSys2 <int>, BPDia2 <int>, BPSys3 <int>, BPDia3 <int>,
#   Testosterone <dbl>, DirectChol <dbl>, TotChol <dbl>,
#   UrineVol1 <int>, UrineFlow1 <dbl>, UrineVol2 <int>,
#   UrineFlow2 <dbl>, Diabetes <fct>, DiabetesAge <int>,
#   HealthGen <fct>, DaysPhysHlthBad <int>, DaysMentHlthBad <int>,
#   LittleInterest <fct>, Depressed <fct>, nPregnancies <int>,
#   nBabies <int>, Age1stBaby <int>, SleepHrsNight <int>,
#   SleepTrouble <fct>, PhysActive <fct>, PhysActiveDays <int>,
#   TVHrsDay <fct>, CompHrsDay <fct>, TVHrsDayChild <int>,
#   CompHrsDayChild <int>, Alcohol12PlusYr <fct>, AlcoholDay <int>,
#   AlcoholYear <int>, SmokeNow <fct>, Smoke100 <fct>,
#   Smoke100n <fct>, SmokeAge <int>, Marijuana <fct>,
#   AgeFirstMarij <int>, RegularMarij <fct>, AgeRegMarij <int>,
#   HardDrugs <fct>, SexEver <fct>, SexAge <int>,
#   SexNumPartnLife <int>, SexNumPartYear <int>, SameSex <fct>,
#   SexOrientation <fct>, PregnantNow <fct>

# 查看前十名

library(dplyr)
library(NHANES)
data(NHANES)
NHANES %>% 
      filter(AgeDecade == " 40-49", Gender == "male") %>%
      group_by(Race1) %>%
      summarize(average = mean(BPSysAve, na.rm = TRUE), 
                standard_deviation = sd(BPSysAve, na.rm = TRUE)) %>%
      arrange(desc(average))

# A tibble: 5 x 3
  Race1    average standard_deviation
  <fct>      <dbl>              <dbl>
1 Black       126.               17.1
2 Mexican     122.               13.9
3 Hispanic    122.               11.1
4 Other       120.               16.2
5 White       120.               13.4

NHANES %>% group_by(AgeDecade, Gender) %>% summarise(n=n())

# n=n() means that a variable named n will be assigned the number of rows (think number of observations) in the summarized data.
# summarize that by the total number of rows in each of the new groups.

---

【Gapminder】

countries = c("Vietnam", "United States")
years = seq(1960, 2010, 1)
tab = gapminder %>%
     filter(country %in% countries, year %in% years)
p <- tab %>% ggplot(aes(year, life_expectancy, color = country)) +
             geom_line()

daydollars <- gapminder %>%
    filter(continent == "Africa" & year == 2010 & !is.na(gdp)) %>%
    mutate(dollars_per_day = gdp/population/365)
daydollars %>%
    ggplot(aes(dollars_per_day)) +
    geom_density() +
    scale_x_continuous(trans = "log2")

---

【Visualization Principles】

• Karl Broman entitled “Creating Effective Figures and Tables”
• 圖表若沒有從0開始，很容易放大(誇飾)對象之間的差距
  • 本來可能只差3000多(19399,15780)，從圖形上看起來卻差了五倍
  • 但若縮小難以比較對象，這時可以取適當的轉換值(log)保持比例
• 長條圖適合體現數值的差距
  • Pie Charts are never prefered.
  • 人類難以快速辨識角度跟面積的比例，因此能用長條圖就不要用圓餅圖
  • 以降冪或升冪排列(R預設是按照字母順序，應使用reorder重新排列)
• box圖適合展現分佈(平均值、標準差、異常值)
• 不要用3D或多維度的圖形，徒增困惑
• 避免過多小數點(R預設7位，事實上只需要1~2位即可)
• 用Table排列數字時，使用column比用row還能夠清楚比較大小

Sequential palettes(high/low)

Diverging palettes(higher→center←lower)

library(RColorBrewer)
data(us_contagious_diseases)
the_disease = "Smallpox"
us_contagious_diseases = subset(us_contagious_diseases, us_contagious_diseases$weeks_reporting >= 10)
# years = us_contagious_diseases$year[which(us_contagious_diseases$weeks_reporting >= 10)]
years = unique(us_contagious_diseases$year)
dat <- us_contagious_diseases %>% 
   filter(!state%in%c("Hawaii","Alaska") & disease == the_disease & year%in%years) %>% 
   mutate(rate = count / population * 10000) %>% 
   mutate(state = reorder(state, rate))
dat %>% ggplot(aes(year, state, fill = rate)) + 
  geom_tile(color = "grey50") + 
  scale_x_continuous(expand=c(0,0)) + 
  scale_fill_gradientn(colors = brewer.pal(9, "Reds"), trans = "sqrt") + 
  theme_minimal() + 
  theme(panel.grid = element_blank()) + 
  ggtitle(the_disease) + 
  ylab("") + 
  xlab("")

data(us_contagious_diseases)
us_contagious_diseases = subset(us_contagious_diseases, us_contagious_diseases$weeks_reporting >= 10)
years = unique(us_contagious_diseases$year)
the_disease = "Smallpox"
dat <- us_contagious_diseases %>%
   filter(!state%in%c("Hawaii","Alaska") & disease == the_disease & year%in%years) %>%
   mutate(rate = count / population * 10000) %>%
   mutate(state = reorder(state, rate))
avg <- us_contagious_diseases %>%
  filter(disease==the_disease) %>% group_by(year) %>%
  summarize(us_rate = sum(count, na.rm=TRUE)/sum(population, na.rm=TRUE)*10000)
dat %>% ggplot() +
  geom_line(aes(year, rate, group = state),  color = "grey50", 
            show.legend = FALSE, alpha = 0.2, size = 1) +
  geom_line(mapping = aes(year, us_rate),  data = avg, size = 1, color = "black") +
  scale_y_continuous(trans = "sqrt", breaks = c(5,25,125,300)) + 
  ggtitle("Cases per 10,000 by state") + 
  xlab("") + 
  ylab("") +
  geom_text(data = data.frame(x=1955, y=50), mapping = aes(x, y, label="US average"), color="black") + 
  geom_vline(xintercept=1963, col = "blue")

data(us_contagious_diseases)

Warning message:
In scan(file = file, what = what, sep = sep, quote = quote, dec = dec,  :
  EOF within quoted string

us_contagious_diseases = subset(us_contagious_diseases, us_contagious_diseases$weeks_reporting >= 10)
years = unique(us_contagious_diseases$year)
us_contagious_diseases %>% filter(state=="California" & year%in%years) %>% 
  group_by(year, disease) %>%
  summarize(rate = sum(count)/sum(population)*10000) %>%
  ggplot(aes(year, rate, color = disease)) + 
  geom_line()

us_contagious_diseases %>%
   filter(!is.na(population)) %>%
   mutate(rate = count / population * 10000) %>%
   mutate(state = reorder(state, rate)) %>% 
   group_by(year, disease) %>%
   summarize(rate = sum(count, na.rm=TRUE)/sum(population, na.rm=TRUE)*10000) %>%
   ggplot(aes(year, rate, color = disease)) + 
   geom_line()

---