Tree plot

library(dplyr); library(stringr); library(ggplot2); library(plotly); library(lubridate); library(readr); library(tidyr); library(showtext); library(colorspace); library(scales)

font_add("QYuan","cwTeXQYuan-Medium.ttf") # 新增字體
showtext_auto(enable=TRUE) #啟用字體
theme_set(theme_classic())
knitr::opts_chunk$set(out.width='80%', fig.asp=.75, fig.align='center', fig.showtext=T)

成品

準備

load(url("https://github.com/tpemartin/course-108-1-inclass-datavisualization/blob/master/%E4%BD%9C%E5%93%81%E5%B1%95%E7%A4%BA/homework4/graphData_homework4_012.Rda?raw=true"))
## ----graph, echo=T, eval=T-----------------------------------------------

# graphData$population %>% View

graphData$population -> hw4data

hw4data %>% 
  filter(
    區域別=="臺 北 市"
  ) -> df_tpe

hw4data %>%
  filter(
    區域別!="臺 北 市"
  ) -> hw4data_notTpe

# First try: Fail
# hw4data_notTpe %>%
# ggplot()+
#   geom_point(
#     aes(x=年齡層, y=比例, color=區域別)
#   )+
#   geom_point(
#     data=df_tpe,
#     mapping=aes(
#       x=年齡層, y=比例
#     )
#   )+
#   geom_line(
#     data=df_tpe,
#     mapping=aes(
#       x=年齡層, y=比例, group=1
#     )
#   )+
#   theme(
#     aspect.ratio = 2/5
#   )


hw4data %>%
  spread(
    區域別,比例
  ) -> hw4dataSpread
minusTpe <- function(x) x-hw4dataSpread$`臺 北 市`
hw4dataSpread %>%
  select(-`臺 北 市`) %>%
  mutate_at(
    .vars=vars(contains("市")),
    .funs =list(~{.-hw4dataSpread$`臺 北 市`})
  )-> hw4dataSpread_diff

df_tpe %>% mutate(比例連加=cumsum(比例)) -> df_tpe

df_tpe %>%
  select(-區域別) %>%
  mutate(
    年齡層=as.character(年齡層)
  ) %>% 
  add_row(
    年齡層='0歲',
    比例=0
  ) %>% 
  arrange(年齡層) %>% #View
  mutate(
    x=0,
    比例=cumsum(比例)
  ) -> df_tpe_append

df_tpe_append$年齡層 %>%
  as.factor() -> df_tpe_append$年齡層
levels(df_tpe_append$年齡層) <- c("14歲以下" ,"15 ~ 24" , "25 ~ 64"  ,"65歲以上","extra")

樹幹

df_tpe_append %>%
  ggplot()+
  geom_path(
    aes(
      x=x,y=比例, color=年齡層, group="all"
    ), size=3, 
  ) +
  geom_label(
    data=df_tpe,
    aes(x=0,y=比例,label=str_c(比例*100,"%")),
    position=position_stack(vjust=0.5), size=2
  )+
  scale_y_continuous(
    expand=expand_scale(add=c(0.1,0.1))
  )+
  scale_color_discrete(
    limits=c('14歲以下','15 ~ 24','25 ~ 64','65歲以上')
  )-> plot_treetrunk

plot_treetrunk

枝葉

記算枝葉高度

hw4dataSpread_diff %>% gather(-年齡層,key="區域別", value="比例") -> hw4data_diff
hw4data_diff %>% #names
  add_row(
    年齡層=unique(hw4data_diff$年齡層),
    區域別="臺 北 市",
    比例=rep(0,4)
  ) -> hw4data_diff
hw4data_diff %>%
  left_join(
    df_tpe %>%
      rename("臺 北 市"="比例連加") %>%
      select(-區域別,-比例),
    by="年齡層"
  ) -> hw4data_diff

hw4data_diff$年齡層 %>%
  as.factor() -> hw4data_diff$年齡層
levels(hw4data_diff$年齡層) <- c("14歲以下" ,"15 ~ 24" , "25 ~ 64"  ,"65歲以上","extra")

hw4data_diff %>%
  arrange(年齡層,比例) %>% #View("diff stack")
  ggplot()+
  geom_point(
    aes(x=比例,y=`臺 北 市`+比例, group=年齡層)
  )

繪圖

plot_treetrunk +
  geom_line(
    data=hw4data_diff %>%
  arrange(年齡層,比例),
    mapping=aes(x=比例,y=`臺 北 市`+比例-0.005, group=年齡層, color=年齡層),
  size=1
  )+
  geom_point(
    data=hw4data_diff %>%
      filter(區域別!="臺 北 市") %>%
      arrange(年齡層,比例),
    mapping=aes(x=比例,y=`臺 北 市`+比例, group=年齡層, shape=區域別), size=2,
  position=position_jitter(height=0.03,width=0)
  )+
  geom_point(
    aes(
      x=x,y=比例
    ), shape=95, 
    size=3, color="white"    # http://sape.inf.usi.ch/sites/default/files/ggplot2-shape-identity.png
  )+
  scale_x_continuous(
    labels=function(x){ x*100},
    position="top")+ 
  theme(
    axis.line.y=element_blank(),
      axis.text.y=element_blank(),
      axis.ticks.y=element_blank(),
      axis.title.y=element_blank(),
      panel.background=element_blank(),
      panel.border=element_blank(),
      panel.grid.major=element_blank(),
      panel.grid.minor=element_blank(),
      plot.background=element_blank(),
    aspect.ratio = 1/1
  )+
  labs(
    title="五都不同年齡層人口結構與臺北市差距",
    subtitle="樹幹為臺北市結構\n樹枝高低反應與臺北市差距百分點(%)",
    x=NULL
  ) -> plot_tree

plot_tree