hw3_upload

Get fb token

https://developers.facebook.com/tools/explorer/145634995501895/

copy token paste to token<-

me$name 確認身份

token <- "EAACEdEose0cBAKC6CpsZBsJmdqIj1frjAhDSohresANjulIZAZBL0kqaewyNMKSZCo1VdTyLZCZBT4QQ4b1yN8o10zlHDMsuPP0zNmqvdTvUFSeceSenZANc9zSQZAtnu8vZAnOCSmSYRB5SHBZCyAd3w8lXkEm0dv2B1ZCY1Evx7TdjBjIQrZBdwbcj8IIfXFrsrxBe1oTAdY2fRQZDZD"
me <- getUsers("me", token, private_info = TRUE)
me$name

## [1] "詹明修"

Get fb page data 從FB捉取文字資料

pageid from fb name

getPage function

page.id <- "193424980763650" #0
page <- getPage(page.id, token, n = 600)

## 25 posts 50 posts 75 posts 100 posts 125 posts 150 posts 175 posts 200 posts 225 posts 250 posts 275 posts 300 posts 325 posts 350 posts 375 posts 400 posts 425 posts 450 posts 475 posts 500 posts 525 posts 550 posts 575 posts 600 posts

str(page)

## 'data.frame':    600 obs. of  11 variables:
##  $ from_id       : chr  "193424980763650" "193424980763650" "193424980763650" "193424980763650" ...
##  $ from_name     : chr  "防汛抗旱粉絲團" "防汛抗旱粉絲團" "防汛抗旱粉絲團" "防汛抗旱粉絲團" ...
##  $ message       : chr  "阿姆斯特丹國際水資源週10月30日至11月3日於荷蘭阿姆斯特丹舉行。主辦單位首次邀請臺灣水利署賴建信署長參加「高階圓桌"| __truncated__ "今年第23號颱風”丹瑞”於今日上午8時形成，對台灣無影響。" "經濟部水利署辦理「臺美水資源技術30週年系列活動」， 10月30日帶領美國墾務局專家參訪曾文水庫防淤隧道工程，美國專家"| __truncated__ "經濟部水利署在國內最大的曾文水庫打造防淤隧道，有全球首創的「象鼻鋼管」及出水口罕見的「山體消能」等設計，目前進"| __truncated__ ...
##  $ created_time  : chr  "2017-11-02T09:02:41+0000" "2017-11-02T05:13:54+0000" "2017-11-01T01:22:42+0000" "2017-11-01T01:17:21+0000" ...
##  $ type          : chr  "link" "photo" "link" "link" ...
##  $ link          : chr  "http://www.wra.gov.tw/6996/7270/99937/" "https://www.facebook.com/193424980763650/photos/a.197747663664715.35500.193424980763650/1278213312284806/?type=3" "http://www.wrasb.gov.tw/news/news01_detail.aspx?no=15&nno=2017103101" "http://news.ltn.com.tw/news/life/breakingnews/2239394" ...
##  $ id            : chr  "193424980763650_1278326692273468" "193424980763650_1278213342284803" "193424980763650_1277357069037097" "193424980763650_1277353632370774" ...
##  $ story         : chr  NA NA NA NA ...
##  $ likes_count   : num  45 19 53 78 22 23 36 13 29 4 ...
##  $ comments_count: num  0 0 0 0 0 0 0 0 0 0 ...
##  $ shares_count  : num  1 1 3 2 2 0 0 0 3 0 ...

names( page )

##  [1] "from_id"        "from_name"      "message"        "created_time"  
##  [5] "type"           "link"           "id"             "story"         
##  [9] "likes_count"    "comments_count" "shares_count"

page$message[ 1:5 ]

## [1] "阿姆斯特丹國際水資源週10月30日至11月3日於荷蘭阿姆斯特丹舉行。主辦單位首次邀請臺灣水利署賴建信署長參加「高階圓桌會議」、「水事業領袖論壇」，與世界各國水事業的產官學領袖同桌討論世界水議題，並分享透過資訊公開以提升民眾防災意識及水利設施維護更新的經驗。賴署長並以專題演講分享臺灣的防洪治水成果，成功將水利發展經驗推向國際，更提升臺灣能見度……\n\n【水利署出席阿姆斯特丹國際水資源週 分享臺灣智慧防災技術】\nhttp://www.wra.gov.tw/6996/7270/99937/"
## [2] "今年第23號颱風”丹瑞”於今日上午8時形成，對台灣無影響。"                                                                                                                                                                                                                                                                                                                                                                                                 
## [3] "經濟部水利署辦理「臺美水資源技術30週年系列活動」， 10月30日帶領美國墾務局專家參訪曾文水庫防淤隧道工程，美國專家實地走入隧道出水口，近距離體驗高達42米高的山體內大坑室消能池，並觀摩象鼻引水鋼管包覆混凝土施工現況暨參觀豎井閘室，讚許本工程特殊工法之設計及施工……\n\n【美國墾務局專家參訪曾文水庫防淤隧道工程】\nhttp://www.wrasb.gov.tw/news/news01_detail.aspx?no=15&nno=2017103101"                                                                 
## [4] "經濟部水利署在國內最大的曾文水庫打造防淤隧道，有全球首創的「象鼻鋼管」及出水口罕見的「山體消能」等設計，目前進度已近98.5﹪，即將完工……\n\n【全球首創象鼻鋼管 曾文水庫防淤隧道近完工】\nhttp://news.ltn.com.tw/news/life/breakingnews/2239394"                                                                                                                                                                                                          
## [5] "嘉南農田水利會表示，依據秋冬季甘蔗雜作水情會議檢討，擬定今年秋冬季甘蔗雜作灌溉取消，以因應水庫水情及時值枯水期進水量不豐，並籲請社會大眾節約用水，穩定後續用水需求……\n\n【嘉南水利會抗旱 取消秋冬季甘蔗雜作灌溉】\nhttps://udn.com/news/story/7326/2788742"

Plot each month like share comment 畫每月讚、分享與評論的情況

format.facebook.date <- function(datestring) {
  date <- as.POSIXct(datestring, format = "%Y-%m-%dT%H:%M:%S+0000", tz = "GMT")
}

# aggregate metric counts over month
aggregate.metric <- function(metric) {
  m <- aggregate(page[[paste0(metric, "_count")]], list(month = page$month),
                 mean)
  m$month <- as.Date(paste0(m$month, "-15"))
  m$metric <- metric
  return(m)
}
# create data frame with average metric counts per month
page$datetime <- format.facebook.date(page$created_time)
page$month <- format(page$datetime, "%Y-%m")
df.list <- lapply(c("likes", "comments", "shares"), aggregate.metric)
df <- do.call(rbind, df.list)
# visualize evolution in metric

library(ggplot2)
library(scales)
ggplot(df, aes(x = month, y = x, group = metric)) +
  geom_line(aes(color = metric)) +
  scale_y_log10("Average count per post",
                breaks = c(2, 10, 50, 100)) +
  theme_bw() +
  theme(axis.title.x = element_blank())

#Use regular expression to extract words ####Rwordseg cannot be installed 因為Rwordseg不能安裝，直接用regular expression取代無用的字

page$message1<-page$message
page$message1<-gsub(pattern = "http(s)?://[a-zA-Z0-9\\./_]+", page$message1, replacement = "")
page$message1<-gsub(pattern = "[A-Za-z]+", page$message1, replacement = "")
page$message1<-gsub(pattern = "[0-9]+\\.[0-9]+", page$message1, replacement = "")
page$message1<-gsub(pattern = "[0-9]+", page$message1, replacement = "")
page$message1<-gsub(pattern = " ", replacement = "", page$message1)
page$message1<-gsub(pattern = ":", replacement = "", page$message1)
page$message1<-gsub(pattern = "【", page$message1, replacement = "")
page$message1<-gsub(pattern = "】", page$message1, replacement = "")
page$message1<-gsub(pattern = "，", page$message1, replacement = "")
page$message1<-gsub(pattern = "；", page$message1, replacement = "")
page$message1<-gsub(pattern = "：", page$message1, replacement = "")
page$message1<-gsub(pattern = "？", page$message1, replacement = "")
page$message1<-gsub(pattern = "／", page$message1, replacement = "")
page$message1<-gsub(pattern = "。", page$message1, replacement = "")
page$message1<-gsub(pattern = "「", page$message1, replacement = "")
page$message1<-gsub(pattern = "」", page$message1, replacement = "")
page$message1<-gsub(pattern = "◎", page$message1, replacement = "")
page$message1<-gsub(pattern = "…", page$message1, replacement = "")
page$message1<-gsub(pattern = "！", page$message1, replacement = "")
page$message1<-gsub(pattern = "（", page$message1, replacement = "")
page$message1<-gsub(pattern = "）", page$message1, replacement = "")
page$message1<-gsub(pattern = "、", page$message1, replacement = "")
page$message1<-gsub(pattern = "》", page$message1, replacement = "")
page$message1<-gsub(pattern = "《", page$message1, replacement = "")
page$message1<-gsub(pattern = "/", page$message1, replacement = "")
page$message1<-gsub(pattern = "\n", page$message1, replacement = "")
page$message1<-gsub(pattern = ")", page$message1, replacement = "")
#page$message1<-gsub(pattern = "(", page$message1, replacement = "")

page$message1<-gsub(pattern = "攼", page$message1, replacement = "")
page$message1<-gsub(pattern = "㹤", page$message1, replacement = "")
page$message1<-gsub(pattern = "愼", page$message1, replacement = "")
page$message1<-gsub(pattern = "㸰", page$message1, replacement = "")
page$message1<-gsub(pattern = "戼", page$message1, replacement = "")
page$message1<-gsub(pattern = "㹣", page$message1, replacement = "")
page$message1<-gsub(pattern = "攼", page$message1, replacement = "")
page$message1<-gsub(pattern = "㹤", page$message1, replacement = "")

page$message1<-gsub(pattern = "㹥", page$message1, replacement = "")
page$message1<-gsub(pattern = "㠼", page$message1, replacement = "")
page$message1<-gsub(pattern = "㸱", page$message1, replacement = "")
page$message1<-gsub(pattern = "㸹", page$message1, replacement = "")
page$message1<-gsub(pattern = "㸴", page$message1, replacement = "")

page$message1<-gsub(pattern = "攼", page$message1, replacement = "")
page$message1<-gsub(pattern = "㠼", page$message1, replacement = "")
page$message1<-gsub(pattern = "㸱", page$message1, replacement = "")
page$message1<-gsub(pattern = "㸹", page$message1, replacement = "")
page$message1<-gsub(pattern = "㸴", page$message1, replacement = "")

page$message1<-gsub(pattern = "㤼", page$message1, replacement = "")
page$message1<-gsub(pattern = "㸲", page$message1, replacement = "")
page$message1<-gsub(pattern = "㸳", page$message1, replacement = "")
page$message1<-gsub(pattern = "㸵", page$message1, replacement = "")
page$message1<-gsub(pattern = "㸶", page$message1, replacement = "")
page$message1<-gsub(pattern = "㸷", page$message1, replacement = "")
page$message1<-gsub(pattern = "㸳", page$message1, replacement = "")
page$message1<-gsub(pattern = "㸸", page$message1, replacement = "")
page$message1<-gsub(pattern = "㸶", page$message1, replacement = "")
page$message1<-gsub(pattern = "㹡", page$message1, replacement = "")
page$message1<-gsub(pattern = "㹢", page$message1, replacement = "")
page$message1<-gsub(pattern = "㹦", page$message1, replacement = "")

“jiebaR” chinese word separate

we can use WOrdcloud2 to plot Dynamics 用WOrdcloud2可畫動態圖

cc = worker()

  
wordcloud_table<-data.frame(table(cc[page$message1]))


wordcloud_table<-wordcloud_table%>%
                 filter(substr(wordcloud_table$Var1, start =1, stop =1)!="U")
wordcloud2(wordcloud_table)

wordcloud(wordcloud_table$Var1, wordcloud_table$Freq, min.freq = 40, random.order = F, ordered.colors = F ,colors = rainbow(50))

改進

1.由於是水利署的fb，但水利 和署分開，應該建立新詞水利署

2.單字看起來重要性皆不大，的數量最高且原始檔有亂碼，刪除單詞

new_user_word(cc, "水利署", "n")

## [1] TRUE

wordcloud_table2<-data.frame(table(cc[page$message1]))
wordcloud_table2<-wordcloud_table2%>%
  filter(nchar(as.vector(wordcloud_table2$Var1))>=2)
wordcloud2(wordcloud_table2)

wordcloud(wordcloud_table2$Var1, wordcloud_table2$Freq, min.freq = 5, random.order = F, ordered.colors = F ,colors = rainbow(50))

由結果來看，機關的部份，水利署是主管機關，經濟部為上屬機關，降雨及颱風資訊主要來源為中央氣象局，故該三個字詞頻率最高係屬合理。 防汛抗旱粉絲團分為防汛及抗旱，防汛的部份主要有颱風、災害、河川、防汛;在抗旱部份有如水庫、水資源、供水、水源、旱災等詞較多亦合於推測。