性別

pie_data <- table(data$"性別") %>% as.data.frame()
names(pie_data) <- c("sex","num")
pie_data <- pie_data %>% mutate(total=sum(.$num)) %>% mutate(freq=num/total)

label <- paste(round(pie_data$freq, digits = 2),"%",sep = "")
#繪製長條圖

pie <- ggplot(pie_data , aes(x="", y=pie_data$freq,
                             fill=pie_data$sex)) +
  geom_bar(width = 1, stat ="identity") +
  coord_polar("y", start=0) +## 再沿著Y，轉軸成圓餅圖
  geom_text(aes(x=1, y = c(0.75,0.25), label=label))
#y為角度
pie

年齡

pie_data <- table(data$"年齡") %>% as.data.frame()
names(pie_data) <- c("age","num")
pie_data <- pie_data %>% mutate(total=sum(.$num)) %>% mutate(freq=num/total)

label <- paste(round(pie_data$freq, digits = 2),"%",sep = "")
#繪製長條圖

pie <- ggplot(pie_data , aes(x="", y=pie_data$freq,
                             fill=pie_data$age)) +
  geom_bar(width = 1, stat ="identity") +
  coord_polar("y", start=0) +## 再沿著Y，轉軸成圓餅圖
  geom_text(aes(x=1, y = c(0.75,0.08,0.25,0.45,0.001), label=label))
#y為角度
pie

#問卷分析 ## 公共交通運輸工具的使用頻率

左圖為捷運右圖為公車，由圖可觀察出機乎不搭公車的人數高達600人(樣本數為946筆)

p1 <- plot_ly(data,x=data$"公共交通運輸工具的使用頻率 [捷運]") %>%
  add_histogram()
p2 <- plot_ly(data,x=data$"公共交通運輸工具的使用頻率 [公車]") %>% add_histogram() 
subplot(p1, p2)%>%layout(title="公共交通運輸工具的使用頻率") 

搭乘公共交通工具的目的

# data$"搭乘公共交通工具的目的(複選)" %>% unique()
# data[which((data$!="幾乎不搭")),] %>% nrow()

goal_other<- data[-grep("上下班或上下學通勤|個人事務|社交娛樂|出遊|購物|洽公出差|無",
            data$"搭乘公共交通工具的目的(複選)"),11] %>% 
  table() %>%
  as.data.frame() %>% 
  arrange(desc(Freq))
names(goal_other) <- c("cause","num")

kable(goal_other) %>% 
  kable_styling(bootstrap_options = c("striped", "hover")) %>% 
  scroll_box(height = "500px")

公車-除了上述問題以外，您認為高雄公車有無其他問題

#資料清理，將無、no、沒有、沒意見、""進行刪除，總個數=699
#946-699=247
ind <- grep("^無$|no|^沒有$|沒意見",
            data$"除了上述提到的問題以外，您認為高雄公車有無其他問題 ( 選填 )")
ind_2 <- which(data$"除了上述提到的問題以外，您認為高雄公車有無其他問題 ( 選填 )" %>% nchar()==0)
ind <- c(ind,ind_2) %>% unique()%>% sort()

kable(data[-ind,17] ) %>% 
  kable_styling(bootstrap_options = c("striped", "hover")) %>% 
  scroll_box(height = "500px")

stop_words_org <- readLines("stop_words.txt",encoding='utf-8')
Encoding(stop_words_org)<-"UTF-8"
new_stop=c("板規","更新","知道","謝謝","刪除","不過","目前","如果",
           "指出","文章","發現","請問","真的","請於","這種","內文","大寫",
           "這裡","只有","其實","有人","xd","韓國瑜","韓總","韓導",
           "陳其邁","高雄","連結","這是","對此","備註","影片","短網址",
           "記者","媒體","完整","日前","公車")
stop_words=c(stop_words_org,new_stop)#ccst[stop_words_org]

my_word_org=readLines("my_dict.txt")
new_word=c("繞","班距","韓國瑜","司機","費用","貴","老舊","班次",
           "髒","環境","遲","時刻表","冷氣","公車站","路線")
my_word=c(my_word_org,new_word)

jieba_tokenizer = worker()
new_user_word(jieba_tokenizer, c(my_word))

## [1] TRUE

chi_tokenizer <- function(t) {
  lapply(t, function(x) {
    if(nchar(x)>1){ # 新增的地方
      tokens <- segment(x, jieba_tokenizer)
      # 去掉字串長度爲1的詞彙
      tokens <- tokens[nchar(tokens)>1]
      return(tokens)
    }
  })
}

other_question <- data_frame(line = 1:nrow(data), text = data[,17])

kable(other_question[-ind,]) %>% 
  kable_styling(bootstrap_options = c("striped", "hover")) %>% 
  scroll_box(height = "500px")

word_and_count <- other_question[-ind,]%>% 
  unnest_tokens(word, text, token=chi_tokenizer) %>%
  filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>% 
  count(line,word, sort = TRUE)  %>% 
  filter(!(word %in% stop_words))
# word_and_count %>%
#   group_by(word)%>% 
#   summarise(sum = sum(n)) %>% 
#   arrange(desc(sum))%>% 
#   wordcloud2()

word_and_count %>%
  group_by(word)%>% 
  summarise(sum = sum(n)) %>% 
  arrange(desc(sum)) %>%
  head(20) %>%
  mutate(word = reorder(word, sum)) %>%
  ggplot(aes(word, sum, fill = sum > 0)) +
  geom_col(show.legend = FALSE) +
  xlab("top 20 word") +
  ylab("count") +
  coord_flip()+ 
  theme() 

# 計算兩個詞彙同時出現的總次數
word_pairs <- word_and_count  %>%
  pairwise_count(word, line, sort = TRUE)
word_pairs

## # A tibble: 10,492 x 3
##    item1 item2     n
##    <chr> <chr> <dbl>
##  1 規劃  路線      7
##  2 路線  規劃      7
##  3 開車  司機      6
##  4 司機  開車      6
##  5 時間  捷運      4
##  6 轉乘  捷運      4
##  7 捷運  時間      4
##  8 路線  時間      4
##  9 搭乘  時間      4
## 10 時間  路線      4
## # ... with 10,482 more rows

# 計算兩個詞彙間的相關性
word_cors <- word_and_count %>%
  group_by(word) %>%
  filter(n() >= 5) %>%
  pairwise_cor(word, line, sort = TRUE)
word_cors

## # A tibble: 1,260 x 3
##    item1 item2 correlation
##    <chr> <chr>       <dbl>
##  1 開車  司機        0.524
##  2 司機  開車        0.524
##  3 分鐘  乘客        0.344
##  4 乘客  分鐘        0.344
##  5 交通  導致        0.344
##  6 導致  交通        0.344
##  7 規劃  路線        0.335
##  8 路線  規劃        0.335
##  9 不便  搭車        0.315
## 10 搭車  不便        0.315
## # ... with 1,250 more rows

word_cors %>%
  filter(item1 == "班次") %>% 
  arrange(desc(abs(correlation))) %>%
  head(10) %>%
  mutate(correlation=abs(correlation)) %>% 
  mutate(item2 = reorder(item2, correlation)) %>%
  ggplot(aes(item2, correlation)) +
  geom_col(show.legend = FALSE) +
  xlab("top 10 word") +
  ylab("correlation") +
  coord_flip()+ 
  labs(title = "班次")+
  theme() 

公車-若改善上述問題，您是否願意搭乘

可由此了解潛在顧客量

#現有顧客625位(平均搭乘頻率>0)
#潛在顧客258位(目前幾乎不搭人數為321位，但問題改善後願意搭乘數量258位)
#非潛在客戶63位
data[which((data$"若改善上述所有問題, 請問您是否會願意搭乘"=="是")&(data$"公共交通運輸工具的使用頻率 [捷運]"=="幾乎不搭")),] %>% nrow()

## [1] 258

data[which((data$"公共交通運輸工具的使用頻率 [捷運]"=="幾乎不搭")),] %>% nrow()

## [1] 321

#資料清理，將無、no、沒有、沒意見、""進行刪除，總個數=699
#946-699=247
ind <- grep("^無$|no|^沒有$|沒意見",data$"若改善後，請問您會搭乘與否的原因是? ( 選填 )")
ind_2 <- which(data$"若改善後，請問您會搭乘與否的原因是? ( 選填 )" %>% nchar()==0)
ind <- c(ind,ind_2) %>% unique()%>% sort()

kable(data[-ind,19]) %>% 
  kable_styling(bootstrap_options = c("striped", "hover")) %>% 
  scroll_box(height = "500px")

stop_words_org <- readLines("stop_words.txt",encoding='utf-8')
Encoding(stop_words_org)<-"UTF-8"
new_stop=c("板規","更新","知道","謝謝","刪除","不過","目前","如果",
           "指出","文章","發現","請問","真的","請於","這種","內文","大寫",
           "這裡","只有","其實","有人","xd","韓國瑜","韓總","韓導",
           "陳其邁","高雄","連結","這是","對此","備註","影片","短網址",
           "記者","媒體","完整","日前","公車")
stop_words=c(stop_words_org,new_stop)#ccst[stop_words_org]

my_word_org=readLines("my_dict.txt")
new_word=c("繞","班距","韓國瑜","司機","費用","貴","老舊","班次",
           "髒","環境","遲","時刻表","冷氣","公車站","路線")
my_word=c(my_word_org,new_word)

other_question <- data_frame(line = 1:nrow(data), text = data[,19])

kable(other_question[-ind,] %>% head()) %>% 
  kable_styling(bootstrap_options = c("striped", "hover")) %>% 
  scroll_box(height = "500px")

word_and_count <- other_question[-ind,]%>% 
  unnest_tokens(word, text, token=chi_tokenizer) %>%
  count(word, sort = TRUE)  %>% 
  filter(!(word %in% stop_words))
#word_and_count %>% wordcloud2()

word_and_count %>%
  arrange(desc(abs(n))) %>%
  head(20) %>%
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(word, n, fill = n > 0)) +
  geom_col(show.legend = FALSE) +
  xlab("top 20 word") +
  ylab("count") +
  coord_flip()+ 
  theme() 

公車-路線班次供給和需求，以下哪個你同意更多

針對地區性進行調整

# data$"路線班次供給和需求，以下哪個你同意更多" %>% unique()
# data[which((data$!="幾乎不搭")),] %>% nrow()

goal_other<- data[-grep("當增加完班次後搭乘人數就會提升|當搭乘人數提升後再增加班次",
            data$"路線班次供給和需求，以下哪個你同意更多"),21] %>% 
  table() %>%
  as.data.frame() %>% 
  arrange(desc(Freq))
names(goal_other) <- c("cause","num")

kable(goal_other) %>% 
  kable_styling(bootstrap_options = c("striped", "hover")) %>% 
  scroll_box(height = "500px")

捷運-你認為高雄捷運有無需要改善的部分

# data$"您認為高雄捷運有無需要改善的部分(複選)" %>% unique()
# data[which((data$!="幾乎不搭")),] %>% nrow()

goal_other<- data[-grep("班次太少|費用太貴|捷運站離太遠不方便|無意見",
            data$"您認為高雄捷運有無需要改善的部分(複選)"),22] %>% 
  table() %>%
  as.data.frame() %>% 
  arrange(desc(Freq))
names(goal_other) <- c("cause","num")

kable(goal_other) %>% 
  kable_styling(bootstrap_options = c("striped", "hover")) %>% 
  scroll_box(height = "500px")

輕軌(第一階段)-你認為高雄輕軌第一階段有無需要改善的地方

#data$"您認為高雄輕軌第一階段有無需要改善的部分(複選)" %>% unique()

goal_other<- data[-grep("班次太少|無意見|車速太緩慢",
            data$"您認為高雄輕軌第一階段有無需要改善的部分(複選)"),23] %>% 
  table() %>%
  as.data.frame() %>% 
  arrange(desc(Freq))
names(goal_other) <- c("cause","num")

kable(goal_other) %>% 
  kable_styling(bootstrap_options = c("striped", "hover")) %>% 
  scroll_box(height = "500px")

輕軌(第二階段)

#清楚且支持:489
#清楚且不支持:79
#不清楚且支持:221
#不清楚且不支持:152
data[which((data$"您是否清楚輕軌二階段建設所增加的路線"=="否")&(data$"您是否支持新建第二階段輕軌"=="是")),] %>% nrow()

## [1] 221

# data$"您支持與否的理由為何?" %>% unique()

goal_other<- data[-grep("預期塔乘人數太少|浪費預算|導致塞車|完善高雄公共交通系統|預期搭乘效果良好|減少碳排放|紓解交通",
            data$"您支持與否的理由為何?"),26] %>% 
  table() %>%
  as.data.frame() %>% 
  arrange(desc(Freq))
names(goal_other) <- c("cause","num")

kable(goal_other) %>% 
  kable_styling(bootstrap_options = c("striped", "hover")) %>% 
  scroll_box(height = "500px")

黃線

#清楚且支持:480
#清楚且不支持:35
#不清楚且支持:331
#不清楚且不支持:90
data[which((data$"您是否清楚捷運黃線所增加的路線"=="否")&(data$"您是否支持新建捷運黃線"=="否")),] %>% nrow()

## [1] 90

#data$"您支持與否的理由為何?" %>% unique()
#有點問題，需要修正

goal_other<- data[-grep("預期塔乘人數太少|浪費預算|導致塞車|完善高雄公共交通系統|預期搭乘效果良好|減少碳排放|紓解交通",
            data[,29]),29] %>% 
  table() %>%
  as.data.frame() %>% 
  arrange(desc(Freq))
names(goal_other) <- c("cause","num")

kable(goal_other) %>% 
  kable_styling(bootstrap_options = c("striped", "hover")) %>% 
  scroll_box(height = "500px")

data[,29] %>% sapply(function(x)strsplit(x,split=";")) %>% unlist %>% table() %>% sort(decreasing = T) %>% names() %>% head(5) %>% paste(collapse = "|")->tmp_1

捷運岡山路竹延伸線

#清楚且支持:480
#清楚且不支持:35
#不清楚且支持:331
#不清楚且不支持:90
data[which((data$"您是否清楚捷運岡山路竹延伸線"=="否")&(data$"您是否清楚捷運岡山路竹延伸線"=="否")),] %>% nrow()

## [1] 458

data[,32] %>% sapply(function(x)strsplit(x,split=";")) %>% unlist %>% table() %>% sort(decreasing = T) %>% names() %>% head(7) %>% paste(collapse = "|")->tmp_1

#data$"您支持與否的理由為何?" %>% unique()
#有點問題，需要修正

goal_other<- data[-grep(tmp_1,data[,32]),32] %>% 
  table() %>%
  as.data.frame() %>% 
  arrange(desc(Freq))
names(goal_other) <- c("cause","num")

kable(goal_other) %>% 
  kable_styling(bootstrap_options = c("striped", "hover")) %>% 
  scroll_box(height = "500px")

捷運小港林園延伸路線

#清楚且支持:480
#清楚且不支持:35
#不清楚且支持:331
#不清楚且不支持:90
data[which((data$"您是否清楚捷運小港林園延伸線"=="否")&(data$"您是否清楚捷運小港林園延伸線"=="否")),] %>% nrow()

## [1] 519

data[,35] %>% sapply(function(x)strsplit(x,split=";")) %>% unlist %>% table() %>% sort(decreasing = T) %>% names() %>% head(6) %>% paste(collapse = "|")->tmp_1

#data$"您支持與否的理由為何?" %>% unique()
#有點問題，需要修正

goal_other<- data[-grep(tmp_1,data[,35]),35] %>% 
  table() %>%
  as.data.frame() %>% 
  arrange(desc(Freq))
names(goal_other) <- c("cause","num")

kable(goal_other) %>% 
  kable_styling(bootstrap_options = c("striped", "hover")) %>% 
  scroll_box(height = "500px")