為什麼我不做資料分析師

所以說，我以後絕對不做資料分析師。

前情提要

這學期 R 語言期末 Project 本來想做「清交二手拍盤子價與市場價格差距比例和被噴的次數是否程正相關」，但由於實在是懶得用一個不習慣的語言寫抓 Facebook 留言 + 爬市場價格的 code，最後還是放棄了。

去了政府的開放資料網站逛了逛資料集，各校退學人數吸引了我的注意。

剛好前不久遇到了台大5天3自殺的案件，想到常在 Facebook 上看到文章談論頂大學生壓力大的問題，於是決定用退學資料做分析。

定義問題

在做資料分析時，非常重要的一點是定義問題。

這邊問題倒是很明確，我會如此定義：「學校 QS 排名與退學人數是否有相關性」

這裡最大的問題是，退學人數與壓力大倒也不是直接相關。或許有些人因為不想退學，因此加倍努力導致壓力更大。於是索性直接做排名跟退學人數的相關性了 XD

分析過程

Pre-Process

load 需要用到的 package

library(ggplot2)
library(dplyr)

整理學校排名的 data.frame

# School Ranking
ranked_schools <- read.csv("ranking.csv")

ranked_schools_process <- function(ranked_schools) {

  # format rank number
  ranked_schools["rank"] <- lapply(ranked_schools["rank"], function(x) as.numeric((regmatches(x,regexpr("[0-9]*$", x)))))

  # format school name
  ranked_schools["title"] <- c("國立臺灣大學", "國立清華大學", "國立成功大學", "國立交通大學", "國立臺灣科技大學", "國立陽明大學", "國立臺灣師範大學", "臺北醫學大學", "國立中山大學", "國立中央大學", "國立臺北科技大學", "長庚大學", "國立政治大學", "國立中興大學", "高雄醫學大學", "國立中正大學")

  # remove unused column
  ranked_schools["detailPage"] <- NULL
  ranked_schools
}

# pre-process ranked_schools
ranked_schools <- ranked_schools_process(ranked_schools)

整理退學資料：

刪掉沒有資料的 column 20 跟 21
把 string 轉成 numeric
把 退學人數小計 加到 在學學生數 裡面，因為 在學學生數 是不包含 退學人數小計 中已經退學的人數，導致之後在算退學 % 數時會有除以 0 的情況
做完 3 之後如果 在學學生數 還是 0 就把這個沒用的資料拿掉

# Suspend
suspend <- read.csv("suspend.csv")

suspend_process <- function(suspend) {
  
  # remove column 20~21 with no data
  suspend[20:21] <- NULL
  
  # change column 10~20 to numeric
  suspend[10:20] <- lapply(suspend[10:20], function(x) as.numeric(x))
  
  # change column 9 to numeric
  suspend[9] <- lapply(suspend[9], function(x) as.numeric(sub(",", "", x, fixed = TRUE)))
  
  # add column 10 to column 9
  suspend[, 9] <- suspend[, 9] + suspend[, 10]
  suspend.raw <- suspend
  
  # remove if column 9 is still 0 after adding column 10
  suspend <- suspend[suspend$在學學生數 != 0, ]
  
  suspend
}

Utilities

接著定義一些協助我們篩選跟處理資料的 function

首先是 suspend_filter()，用來篩選資料：

suspend_filter <- function(suspend, restriction) {
  if(restriction == "college")
    suspend <- suspend[suspend$學校類別 == "一般大學", ]
  else if(restriction == "tech")
    suspend <- suspend[suspend$學校類別 == "技專校院", ]
  else if(restriction == "ranked")
    suspend <- suspend[suspend$學校名稱 %in% ranked_schools$title, ]
  else if(restriction == "unranked")
    suspend <- suspend[!(suspend$學校名稱 %in% ranked_schools$title), ]
  else if(restriction == "bachelor")
    suspend <- suspend[grepl("學士", suspend$學制班別, fixed = TRUE), ]
  else if(restriction == "master")
    suspend <- suspend[grepl("碩士", suspend$學制班別, fixed = TRUE), ]
  else if(restriction == "phd")
    suspend <- suspend[grepl("博士", suspend$學制班別, fixed = TRUE), ]
  else if(restriction == "day")
    suspend <- suspend[grepl("日間", suspend$學制班別, fixed = TRUE), ]
  else if(restriction == "night")
    suspend <- suspend[grepl("進修", suspend$學制班別, fixed = TRUE), ]
  else if(restriction == "public")
    suspend <- suspend[suspend$設立別 == "公立", ]
  else if(restriction == "private")
    suspend <- suspend[suspend$設立別 == "私立", ]
  suspend
}

這樣用 dlpyr 的 %>% (pipe) 運算子我們就能很方便地做多條件篩選。比如我們想篩選出 一般大學 -> 學士班 -> 日間部，我們就可以用以下寫法：

selected <- suspend %>% 
            suspend_filter("college") %>% 
            suspend_filter("bachelor") %>% 
            suspend_filter("day")

接著是 suspend_clean()，用來把資料刪到剩下做圖需要的欄位、計算退學百分比與合併男女。

suspend_clean <- function(suspend, target, merge_gender) {
  if(missing(merge_gender))
    merge_gender = FALSE
  
  # clean up data
  if(merge_gender) {
    suspend <- suspend %>% group_by(學校名稱) %>% summarise(total = sum(在學學生數), target = sum(eval(as.name(target))))
    suspend$name <- suspend$學校名稱
    suspend$學校名稱 <- NULL
  }
  else {
    tmp <- suspend
    suspend <- NULL
    suspend <- data.frame(
      "name" = tmp$學校名稱,
      "target" = as.vector(tmp[[target]]), 
      "total" = tmp$在學學生數
    )
  }
  
  # calculate percentage of suspension
  suspend$rate <- suspend$target / suspend$total
  
  suspend
}

Visualization

接著就可以開始畫圖了。

QS 排名與退學率之關係

篩選資料：「前段班」

selected <- suspend %>% suspend_filter("ranked") %>% suspend_clean("退學人數小計")
selected <- selected[order(match(selected$name, ranked_schools$title)), ]
selected$rank <- ranked_schools$rank

繪製散佈圖

ggplot(selected, aes(rank, rate)) + geom_jitter()

這樣好像看不太出什麼趨勢。

做個 Regression 試試好了：

ggplot(selected, aes(rank, rate)) + geom_jitter() + geom_smooth(method = "lm")

好像有個趨勢，但不對，不是應該排名比較前面壓力比較大 -> 退學率比較高嗎？

因為台清交成有許多在職專班，壓力比較小？

大學部

篩選資料：

「前段班」
大學部

selected <- suspend %>% 
  suspend_filter("ranked") %>% 
  suspend_filter("bachelor") %>% 
  suspend_clean("退學人數小計")
selected <- selected[order(match(selected$name, ranked_schools$title)), ]
selected$rank <- ranked_schools$rank

ggplot(selected, aes(rank, rate)) + geom_jitter() + geom_smooth(method = "lm")

太棒了，趨勢正在消失。

我們再把範圍縮小到只有日間部的學生試試。

日間部

篩選資料：

「前段班」
大學部
日間部

selected <- suspend %>% 
  suspend_filter("ranked") %>% 
  suspend_filter("bachelor") %>% 
  suspend_filter("day") %>% 
  suspend_clean("退學人數小計")
selected <- selected[order(match(selected$name, ranked_schools$title)), ]
selected$rank <- ranked_schools$rank

這樣看下來，幾乎沒有趨勢了。學校排名根本與退學率無關，什麼台大學生壓力大都是假的。

我們不妨換個角度看看：退學原因。

因為學業成績而退學的人

篩選資料：

「前段班」
大學部

這次我們從「退學人數小計」改為觀察「因學業成績退學人數」。

selected <- suspend %>% 
  suspend_filter("ranked") %>% 
  suspend_filter("bachelor") %>% 
  suspend_clean("因學業成績退學人數")
selected <- selected[order(match(selected$name, ranked_schools$title)), ]
selected$rank <- ranked_schools$rank

ggplot(selected, aes(rank, rate)) + geom_jitter() + geom_smooth(method = "lm")

可以觀察到，雖然有下降的趨勢，但仍然非常不明顯。而關鍵的台大也不太符合趨勢。

退學原因比例

selected <- suspend
selected$type <- selected$學校名稱 %in% ranked_schools$title
selected$type <- lapply(selected$type, function(x) {
  if(x)
    "ranked"
  else
    "unranked"
})
selected <- selected %>% group_by(type) %>% summarise_at(11:20, sum)
selected <- as.data.frame(selected)
selected <- data.frame(
  "type"   = rep(c("ranked", "unranked"), each = 10),
  "reason" = rep(unlist(dimnames(selected)[2], use.names = FALSE)[2:11], times = 2), 
  "count"  = c(unlist(selected[1, 2:11], use.names = FALSE), unlist(selected[2, 2:11], use.names = FALSE))
)

selected <- selected[selected$type == "ranked", ]
ggplot(selected, aes(x="", y = count, fill = reason)) +
  geom_bar(width = 1, stat = "identity") +
  coord_polar("y", start=0) +
  theme(text=element_text(family = "黑體-繁 中黑", size = 12))

有 QS 排名 vs 沒 QS 排名

selected <- suspend
selected$type <- selected$學校名稱 %in% ranked_schools$title
selected$type <- lapply(selected$type, function(x) {
  if(x)
    "ranked"
  else
    "unranked"
})
selected <- selected %>% group_by(type) %>% summarise_at(11:20, sum)
selected <- as.data.frame(selected)
selected <- data.frame(
  "type"   = rep(c("ranked", "unranked"), each = 10),
  "reason" = rep(unlist(dimnames(selected)[2], use.names = FALSE)[2:11], times = 2), 
  "count"  = c(unlist(selected[1, 2:11], use.names = FALSE), unlist(selected[2, 2:11], use.names = FALSE))
)

ggplot(selected, aes(x = type, y = count, fill = reason)) +
  geom_bar(stat = "identity", position = "fill") +
  theme(text=element_text(family = "黑體-繁 中黑", size = 12))

結論

我認為結果不明顯有以下三個原因：

樣本大小

由於上 QS 排名的台灣大學也就16間，或許由於樣本數太少，無法觀察到明顯趨勢。

校園風氣

雖然壓力大有可能導致退學，但或許有些學生會因同儕競爭關係，硬撐著不退學，導致在壓力大的環境下仍然持續就學。白話來說，或許壓力大跟退學沒什麼關係。

確實無關

或許退學率與 QS 排名確實無關。

後記

上了大學有幾次做資料分析的機會。多數是在為 Deep Learning 做資料前處理，很少有像這樣單純把資料視覺化後找出關係的機會。

我一直都很討厭不明確的事情。資料分析就是如此，雖然確實會定義一個問題並從資料中找出相關規律，但尋找規律的過程幾乎是漫無目的的。

所以說，我以後絕對不做資料分析師。