Visualizing Language Loss in Taiwan: Create an “Age-Sex Pyramid of Language” with ggplot2

Figure 1: An age-sex pyramid of Taiwanese. The red bars on the left indicates females of different age groups and the blue bars on the right indicates males. The average fluency (values on the horizontal axis) is calculated from a six-point scale (0-5) on Taiwanese fluency.

Preparation of Data

The raw data of Taiwan Language Survey can be retrieved here . The survey and raw data is in traditional Chinese. I’ll skip the step of cleaning raw data (e.g., turn variable names to English) and used the cleaned data survey.rds instead.

temp <- tempfile()
download.file('https://raw.githubusercontent.com/twLangSurvey/twLangSurvey.github.io/master/data/survey.rds', destfile = temp)
data <- readr::read_rds(temp)
head(data, 3)

The survey data, data , contains 22 variables and 257 observations (subjects). I only need these variables below to create the plot I want:

• gender : The gender of the subject
• age : The age of the subject
• m_guard_identity : Male guardian of the subject, should be ‘father’ in most cases
• f_guard_identity : Female guardian of the subject, should be ‘mother’ in most cases
• <lang>_speak : The subject’s fluency of a language. <lang> is one of ‘Mand’ (Mandarin), ‘Tw’ (Taiwanese), ‘Hak’ ( Hakka ), ‘Ind’ (languages of the indigenous peoples, aka Formosan languages , belong to Austronesian languages), ‘SEA’ (languages from South Easth Asia), and ‘Eng’ (English)
• dad_<lang>_speak : The subject’s male guardian’s fluency of a language. <lang> is same as above.
• mom_<lang>_speak : The subject’s female guardian’s fluency of a language. <lang> is same as above.

library(dplyr)
lang <- c('Mand', 'Tw', 'Hak', 'Ind', 'SEA', 'Eng')
cols <- c('gender', 'age', 'm_guard_identity', 'f_guard_identity',
          paste0(lang, '_speak'), 
          paste0('dad_', lang, '_speak'),
          paste0('mom_', lang, '_speak')
          )
data <- data[, cols] %>%
    filter(gender == '男' | gender == '女')

Since some content of the survey data is in Chinese, the code below is used to translate it to English:

ch2eng <- function(x) {
  if (x == '男') return('Male')
  if (x == '女') return('Female')
  if (x == '母親') return('Mother')
  if (x == '父親') return('Father')
  if (x == '無') return('None')
  if (x == '(外)祖父') return('Grandpa')
  if (x == '(外)祖母') return('Grandma')
  if (x %in% c('阿姨', '嬸嬸', '舅媽', '姑姑', '伯母')) return('Aunt')
  if (x %in% c('叔叔', '伯伯', '舅舅', '姑丈', '姨丈')) return('Uncle')
  message('No translation found for `', x, '`', '\n')
  return(x)
}

ch2eng_vec <- function(vec) {
  new_vec <- vector(typeof(vec), length(vec))
  for (i in seq_along(vec)) {
    new_vec[[i]] <- ch2eng(vec[[i]])
  }
  return(new_vec)
}

data <- data %>% 
  mutate(gender = ch2eng_vec(gender),
         m_guard_identity = ch2eng_vec(m_guard_identity),
         f_guard_identity = ch2eng_vec(f_guard_identity))
head(data)

filter_ethnic <- function(df, lang, lev = 3) {
    sp_lang <- vector("character", 3)
    sp_lang[1] <- paste0("dad_", lang, "_speak")
    sp_lang[2] <- paste0("mom_", lang, "_speak")
    sp_lang[3] <- paste0(lang, "_speak")
    
    df2 <- df %>% 
      filter(m_guard_identity != 'None' | f_guard_identity != 'None') %>%
      filter(.data[[sp_lang[1]]] >= lev | .data[[sp_lang[2]]] >= lev) %>%
      select(age, gender, sp_lang) 
    return(df2)
}

Assinging Age Group to Subjects

Remember that the data structure needed for plotting age-sex pyramids requires age group to be the basic unit . data now consisits of single subjects, and we need information to group subjects together according to their ages. mutate_age_group() creates a new variable age_group by the subject’s age.

mutate_age_group <- function(df, range = 5){
    df$age_group <- as.character(
      cut(df$age, right = F, breaks = seq(10, 95, by = range))
    )
    return(df)
}

cut() takes a numeric vector as its first input, and codes the values of the vector into new values according to the interval they fall into. In mutate_age_group() , cut() codes the input vectors according to the intervals specified in the argument breaks .

Now we can use these functions to add more information to the data frame. The idea is to first create a separated data frame for each ethnicity(by filter_ethnic() ), then attact new variables to the data frame that indicate a subject’s ethnicity ( ethn_group ) and age group ( age_group ).

lang <- c('Mand', 'Tw', 'Hak', 'Ind', 'SEA', 'Eng')
lev <- c(3, 3, 3, 3, 3, 0)
ethn_list_df <- vector("list", length(lang))

for (i in seq_along(lang)){
  ethn_list_df[[i]] <- filter_ethnic(data, 
                                     lang = lang[i], 
                                     lev = lev[i]) %>%
    mutate(ethn_group = lang[i]) %>%
    mutate_age_group() %>%
    select(age, gender, age_group, ethn_group,
           paste0(lang[i], "_speak")) %>%
    rename(lang_fluency = paste0(lang[i], "_speak"))
}

Then we can recombine these data frames back to a single one, and this new data frame now has information about a subject’s ethinicity and age group he/she belongs to. (Note that the new data frame is expended since one subject can have several ethnicity, i.e. one subject can appear in different rows of the data frame with different ethnicity.)

bind_rows(ethn_list_df) %>% head()

Data for Plotting

Finally, we are ready to group the subjects together according to his/her gender , ethnicity , and age_group . After grouping, we can use dplyr::summarise() to calculate each group’s fluency of the language, which will be used as the variable on the horizontal axis of the age-sex pyramid.

pl_data <- bind_rows(ethn_list_df) %>%
  group_by(gender, ethn_group, age_group) %>%
  summarise(mean(lang_fluency)) %>%
  rename(avg_fluency = `mean(lang_fluency)`)

head(pl_data)

Plotting Function

We are going to draw 6 age-sex pyramids, one for each languages. So instead of writing ggplot() six times, I wrote a plotting function:

library(ggplot2)
pl_pyramid <- function(data, title = NULL) {
  ggplot(data,
         aes(x = age_group,
             y = ifelse(gender == 'Male', avg_fluency, -avg_fluency),
             fill = gender)) +
  geom_bar(stat = "identity", width = 0.7) +
  scale_y_continuous(limits = c(-5, 5),
                     breaks = seq(-5, 5, 1),
                     labels = abs(seq(-5, 5, 1))) +
  coord_flip() +
  scale_fill_manual(values = c("#E41A1C", "#377EB8"),
                    breaks = c("Female", "Male")) +
  labs(x = "Age", y = "Fluency", fill = "", title = title)
}

Now we can start plotting. Let’s try Mand (Mandarin) and Hak (Hakka) first. We can use dplyr::filter() to filter out people speaking these languages:

tweak <-  theme_bw() + 
  theme(axis.text = element_text(size = 15),
        legend.justification = "right",
        legend.position = "bottom",
        legend.box = "vertical")

pl_data %>%
  filter(ethn_group == 'Mand') %>% 
  pl_pyramid(title = 'Mandarin') + tweak

pl_data %>%
  filter(ethn_group == 'Ind') %>% 
  pl_pyramid(title = 'Formosan Languages') + tweak

Wait! It seems quite strange. The age-sex pyramid of ‘Formosan Languages’ doesn’t look like a pyramid at all! This is because there were very few subjects defined as ‘indigenous people’ in the survey. To make plots like this (with only one or two age groups) comparable to others (such as that in ‘Mandarin’), we need one more function to insert missing age groups to the data frame so that ggplot can draw empty bars for us.

First, we need to find out all age groups in the data :

age_groups <- unique(pl_data$age_group)
age_groups

[1] "[15,20)" "[20,25)" "[25,30)" "[30,35)" "[35,40)" "[40,45)" "[45,50)"
 [8] "[50,55)" "[55,60)" "[60,65)" "[65,70)"

Then we can write a function fill_empty_age_group() , which takes a data frame as its first argument and checks whether there are age groups missing in the data frame (using its second argument, age_group_all , as comparison). If the age group is missing, fill_empty_age_group() appends a new row, which has age_group set to the missing age group and avg_fluency set to 0 (create an empty bar), to the input data frame.

fill_empty_age_group <- function(df, age_group_all) {
  for (i in seq_along(age_group_all)) {
    if (!(age_group_all[i] %in% df$age_group)) {
      df <- rbind(df, list(gender = "Female",
                           ethn_group = "doesnt_matter",
                           age_group = age_group_all[i],
                           avg_fluency = 0))
    }
  }
  return(df)
}

Now we’re ready to explore language loss in Taiwan. multiplot() is used to put multiple plots together. The source code of multiplot() is copied directly from Winston Chang’s Cookbook for R .

tweak2 <-  theme_bw() + 
  theme(legend.justification = "right",
        legend.position = "bottom",
        legend.box = "vertical")

py1 <- pl_data %>%
  filter(ethn_group == 'Mand') %>% 
  fill_empty_age_group(age_groups) %>%
  pl_pyramid(title = 'Mandarin') + tweak2

py2 <- pl_data %>%
  filter(ethn_group == 'Tw') %>%
  fill_empty_age_group(age_groups) %>%
  pl_pyramid(title = 'Taiwanese') + tweak2

py3 <- pl_data %>%
  filter(ethn_group == 'Hak') %>%
  fill_empty_age_group(age_groups) %>%
  pl_pyramid(title = 'Hakka') + tweak2

py4 <- pl_data %>%
  filter(ethn_group == 'Ind') %>%
  fill_empty_age_group(age_groups) %>%
  pl_pyramid(title = 'Formosan Languages') + tweak2

py5 <- pl_data %>%
  filter(ethn_group == 'SEA') %>%
  fill_empty_age_group(age_groups) %>%
  pl_pyramid(title = 'Languages of South East Asia') + tweak2

py6 <- pl_data %>%
  filter(ethn_group == 'Eng') %>%
  fill_empty_age_group(age_groups) %>%
  pl_pyramid(title = 'English') + tweak2

multiplot(py1, py2, py3, py4, py5, py6, cols = 2)