正規表達法斷句
article <- '東北季風影響，今天清晨中部以北及宜蘭、花蓮還是有點涼。中央氣象局表示，今天白天北台灣23至26℃，中、南部27至30℃，提醒南來北往的民眾留意溫度變化，適時調整穿著。氣象局預測，明天至周四上午氣溫將大幅回升，中部以北白天約28至29℃，南部可達30至31℃，東半部雲量稍多，也有26至28℃。'
strsplit(x = article, split = '，|。|、')
## [[1]]
## [1] "東北季風影響" "今天清晨中部以北及宜蘭"
## [3] "花蓮還是有點涼" "中央氣象局表示"
## [5] "今天白天北台灣23至26℃" "中"
## [7] "南部27至30℃" "提醒南來北往的民眾留意溫度變化"
## [9] "適時調整穿著" "氣象局預測"
## [11] "明天至周四上午氣溫將大幅回升" "中部以北白天約28至29℃"
## [13] "南部可達30至31℃" "東半部雲量稍多"
## [15] "也有26至28℃"
使用JiebaR
library(jiebaR)
## Warning: package 'jiebaR' was built under R version 3.4.2
## Loading required package: jiebaRD
sentence <- '提醒南來北往的民眾留意溫度變化'
mixseg <- worker()
segment(sentence, jiebar = mixseg)
## [1] "提醒" "南來北往" "的" "民眾" "留意" "溫度"
## [7] "變化"
s <- '那我們酸民婉君也可以報名嗎?'
segment(s, jiebar = mixseg)
## [1] "那" "我們" "酸民" "婉君" "也" "可以" "報名" "嗎"
edit_dict()
## Warning in edit_dict(): You should save the dictionary without BOM on
## Windows
USERPATH
## [1] "C:/Program Files/R/R-3.4.1/library/jiebaRD/dict/user.dict.utf8"
tagseg <- worker('tag')
segment(s, jiebar = tagseg)
## r r n n d c v y
## "那" "我們" "酸民" "婉君" "也" "可以" "報名" "嗎"
抓取新聞關鍵字
library(rvest)
## Warning: package 'rvest' was built under R version 3.4.2
## Loading required package: xml2
keywords <- read_html('http://news.ltn.com.tw/news/business/breakingnews/2265682') %>% html_nodes('.keyword a') %>% html_text()
f <- file("C:/Program Files/R/R-3.4.1/library/jiebaRD/dict/user.dict.utf8", 'a', encoding = 'utf-8')
writeLines('', f)
for(keyword in keywords){
writeLines(keyword, f)
}
close(f)
edit_dict()
## Warning in edit_dict(): You should save the dictionary without BOM on
## Windows
繪製文字雲
news <- '衛生福利部今天正式啟用1966長照專線，行政院長賴清德上台致詞時，談及長照預算年年增加，但是經費再多仍需要愛心，提及當年台南大地震時，全台警消湧入救援，甚至還有警消沒向家人報備直衝台南，譬喻這是功德台灣，話鋒一轉，談及照服員雖然只有三萬元的薪水，與工作實質內容相比，好像不划算，但是他要勉勵照服員要功德台灣。
賴清德表示，台灣今年已經邁入高齡化社會，65歲以上的人口已經超過14％，總統蔡英文於競選時就提出長照2.0希望能解決台灣老化問題，目前長照服務已經從原本的8項服務擴及到17項，目前的服務點也達到700多個。
因應老化社會，賴清德感謝總統蔡英文與立法院的支持，去年長照1.0預算達50幾億，今年長照2.0預算約300多億，明年則有800多億，但是經費再多、點再多，仍需要再多加一個「愛心」。
目前長照的服務對象，不是失智就是身障，屬於長時間的身心靈問題，不管是病人本身，身體與心靈的需求家庭等都需要拿出愛心、耐心，還是要忍耐，協助他們，這個才能把事情做好，常常甚於於真正進入到職場，碰到困難時，有時不是說講愛心耐心包容心就可以解決的，可能大家想，這是助人為快樂之本。
賴清德說，自己常講幫助別人就是做功德的事，做功德的事情，台灣是一個功德社會，這也是幫助別人，幫助別人是做功德的事情，台灣是一個功德社會，台南市地震時，全台警消一下就趕下來，細問之下，才知道他們看見消息就直接就下來，沒有回去跟太太說，沒有回去整理衣物，因為救人如救火。
當時台南市開放募款，1周內就湧進四十幾萬筆的捐款，台灣社會真的很了不起。那我們照服員在照顧老人，會說啊！三萬多塊錢，好像不划算，工作的條件已經超過忍耐的程度，愛心施展有一點點困難，他要在這邊也要勉勵照服員這是一做個功德台灣，這一個做善事的行為，若是真的碰到困難的，也希望衛福部這邊有機制可以解決。'
library(jiebaR)
edit_dict()
## Warning in edit_dict(): You should save the dictionary without BOM on
## Windows
mixseg <- worker()
seg <- segment(news, jiebar =mixseg)
tb <- table(seg)
#install.packages('wordcloud2')
library(wordcloud2)
## Warning: package 'wordcloud2' was built under R version 3.4.2
nchar(names(tb))
## [1] 1 3 2 2 4 3 3 2 2 3 1 3 1 2 2 3 3 2 3 3 3 2 2 1 1 2 2 2 1 2 3 2 2 2 2
## [36] 1 2 2 1 2 1 2 2 2 1 1 2 2 2 3 1 2 2 2 2 3 2 2 2 2 2 3 2 1 2 3 1 2 2 2
## [71] 1 2 1 2 2 2 1 2 1 2 2 2 2 4 2 2 2 2 2 2 2 2 2 2 1 1 2 1 2 2 1 1 2 1 2
## [106] 2 1 2 2 1 2 2 2 2 2 1 3 2 2 1 2 1 1 2 2 2 2 1 2 2 1 2 1 1 2 2 2 2 2 1
## [141] 2 2 2 2 1 2 1 2 2 2 2 2 2 1 4 2 2 2 1 2 2 2 2 1 2 2 1 2 2 2 2 1 2 2 2
## [176] 1 2 2 2 2 1 2 2 1 2 2 1 1 1 3 4 2 2 2 4 2 2 4 1 1 2 2 2 2 3 1 1 2 2 3
## [211] 2 2 2 1 2 3 2 2 2 3 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2
grepl('[\u4e00-\u9fa5]+',names(tb))
## [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [12] FALSE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [23] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [34] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [45] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [56] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [67] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [78] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [89] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [100] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [111] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [122] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [133] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [144] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [155] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [166] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [177] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [188] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [199] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [210] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [221] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [232] TRUE TRUE TRUE TRUE
tb2 <- tb[(nchar(names(tb)) >= 2) &( grepl('[\u4e00-\u9fa5]+',names(tb))) & (tb > 2)]
wordcloud2(sort(tb2))
tb2
## seg
## 一個 已經 功德 台灣 目前 但是 別人 事情 服務 社會
## 4 4 8 8 3 3 3 3 4 5
## 這是 愛心 照服員 解決 預算 需要 賴清德 幫助 警消
## 3 5 3 3 3 3 4 3 3
N-Gram 斷詞
library(NLP)
s2 <- strsplit(c('妳好嗎', '我很好'), split = '')
s2
## [[1]]
## [1] "妳" "好" "嗎"
##
## [[2]]
## [1] "我" "很" "好"
s <- strsplit('那酸民婉君也可以報名嗎', split = '')
bigram <- ngrams(unlist(s), 2)
vapply(bigram, paste, '', collapse = '')
## [1] "那酸" "酸民" "民婉" "婉君" "君也" "也可" "可以" "以報" "報名" "名嗎"
s <- strsplit('那酸民婉君也可以報名嗎', split = '')
trigram <- ngrams(unlist(s), 3)
vapply(trigram, paste, '', collapse = '')
## [1] "那酸民" "酸民婉" "民婉君" "婉君也" "君也可" "也可以" "可以報" "以報名"
## [9] "報名嗎"
news <- '衛生福利部今天正式啟用1966長照專線，行政院長賴清德上台致詞時，談及長照預算年年增加，但是經費再多仍需要愛心，提及當年台南大地震時，全台警消湧入救援，甚至還有警消沒向家人報備直衝台南，譬喻這是功德台灣，話鋒一轉，談及照服員雖然只有三萬元的薪水，與工作實質內容相比，好像不划算，但是他要勉勵照服員要功德台灣。
賴清德表示，台灣今年已經邁入高齡化社會，65歲以上的人口已經超過14％，總統蔡英文於競選時就提出長照2.0希望能解決台灣老化問題，目前長照服務已經從原本的8項服務擴及到17項，目前的服務點也達到700多個。
因應老化社會，賴清德感謝總統蔡英文與立法院的支持，去年長照1.0預算達50幾億，今年長照2.0預算約300多億，明年則有800多億，但是經費再多、點再多，仍需要再多加一個「愛心」。
目前長照的服務對象，不是失智就是身障，屬於長時間的身心靈問題，不管是病人本身，身體與心靈的需求家庭等都需要拿出愛心、耐心，還是要忍耐，協助他們，這個才能把事情做好，常常甚於於真正進入到職場，碰到困難時，有時不是說講愛心耐心包容心就可以解決的，可能大家想，這是助人為快樂之本。
賴清德說，自己常講幫助別人就是做功德的事，做功德的事情，台灣是一個功德社會，這也是幫助別人，幫助別人是做功德的事情，台灣是一個功德社會，台南市地震時，全台警消一下就趕下來，細問之下，才知道他們看見消息就直接就下來，沒有回去跟太太說，沒有回去整理衣物，因為救人如救火。
當時台南市開放募款，1周內就湧進四十幾萬筆的捐款，台灣社會真的很了不起。那我們照服員在照顧老人，會說啊！三萬多塊錢，好像不划算，工作的條件已經超過忍耐的程度，愛心施展有一點點困難，他要在這邊也要勉勵照服員這是一做個功德台灣，這一個做善事的行為，若是真的碰到困難的，也希望衛福部這邊有機制可以解決。'
s <- strsplit(news, split = '')
bigram <- ngrams(unlist(s), 2)
bigram.str <- vapply(bigram, paste, '', collapse = '')
tb <- table(bigram.str)
tb[tb >= 5]
## bigram.str
## ，台 。\n 功德 台灣 社會 長照 愛心 照服
## 5 5 8 8 5 7 5 5
s <- strsplit(news, split = '')
trigram <- ngrams(unlist(s), 3)
trigram.str <- vapply(trigram, paste, '', collapse = '')
tb <- table(trigram.str)
tb[tb >= 3]
## trigram.str
## ，台灣 ，但是 。\n\n 00多 功德台 功德的 助別人 社會， 個功德 做功德
## 4 3 4 3 3 3 3 4 3 3
## 照服員 德台灣 德的事 賴清德 幫助別
## 4 3 3 4 3
a.split <- strsplit(news, '，|。|\n|！|「|」|、')
w.split <- strsplit(x = unlist(a.split), split = '')
ngram <- function(w, n){
n_gram <- ngrams(w,n)
ngram.str <- vapply(n_gram, paste, '' , collapse = '')
ngram.str
}
ngram.all <- sapply(w.split, function(e)ngram(e,3) )
tb <- table(unlist(ngram.all))
tb[tb >= 4]
##
## 照服員 賴清德
## 4 4
# method 1
s <- '自己常講幫助別人就是做功德的事'
strsplit(s, '做功德')
## [[1]]
## [1] "自己常講幫助別人就是" "的事"
paste(unlist(strsplit(s, '做功德')), sep = '', collapse = '')
## [1] "自己常講幫助別人就是的事"
# method 2
gsub(x = s, pattern = '做功德', replacement = '')
## [1] "自己常講幫助別人就是的事"
# remove keyword function
removeKey <- function(s, keys){
for(key in keys){
s <- gsub(x = s, pattern = key, replacement = '')
}
return(s)
}
removeKey(s, c('做功德', '自己') )
## [1] "常講幫助別人就是的事"
# n_gram function
ngram.func <- function(w, n){
n.gram <- ngrams(unlist(w), n)
#print(w)
n.gram.str <- vapply(n.gram, paste , '' , collapse='')
return(n.gram.str)
}
ngram.func(strsplit('自己常講幫助別人就是做功德的事',''), 2)
## [1] "自己" "己常" "常講" "講幫" "幫助" "助別" "別人" "人就" "就是" "是做"
## [11] "做功" "功德" "德的" "的事"
i <- 5
keywords <- c()
a.split <- strsplit(news, '，|。|\n|！|「|」|、')
w.split <- strsplit(x = unlist(a.split), split = '')
n.gram.all <- sapply(w.split,function(e) ngram.func(e,i))
tb <- table(unlist(n.gram.all))
candidate <- names(tb[tb >= 3])
keyword <- c(keyword, candidate)
candidate
## [1] "做功德的事"
news <- '在台北捷運公司董事長董瑞斌轉戰第一金控後，在他任內推動由北捷參與台北雙子星的開發案也確定宣告「胎死腹中」，北捷在跨足不動產過程中，只能望這上看700億元的投資開發案「興嘆」，據了解，兩大關鍵，讓北捷出局。
一是北捷要透過轉投資物業開發管理公司，去參與投標，但北捷卻僅佔該公司持股25%，75%要引入其他股東，讓北市府提出兩大質疑，一是為何北捷要轉投資、成立另外一家公司來做？而不是北捷自己來做？是沒有能力、還是有其他問題。
其次，就算要轉投資另一家公司來參與投標，為何北捷握有該家公司不是100%持股？持股只佔25%過低。
北市府認為，若北捷要轉投資物業開發管理公司來參與投標，就需100%持股，開發土地後，再和當地的地主合建，而不是找其他夥伴來共同開發。
北市府質疑在先，後又有近期慶富弊案爆發，更讓北市長柯文哲憂心。北市府認為，這類大型政府開發案，若招標過程，全由北捷「一手主導」，更容易引發疑慮，讓人民失去信心。
「瓜田李下」疑慮
為挽回人民對BOT案信心，柯文哲大手一揮，拍定北捷退出雙子星開發案。台北捷運公司原預計分5年共出資50億元，成立股本約200億元的「北捷物業開發及管理股份有限公司」，經營商用不動產，瞄準合作團隊包括壽險業者、大型開發商、外資地產和營運業者等。
而台北雙子星開發案，更是北捷該轉投資公司的第一個標案，眾所矚目，但因持股過低、又因北市府是地主，「瓜田李下」備受質疑。據了解，北捷痛失該雙子星開發案後，該「北捷物業開發管理公司」可能改以全台軌道建設車站開發等其他開發案為主。 '
keywords <- c()
for (i in seq(4,2,-1)){
news <- removeKey(news, keywords)
a.split <- strsplit(news, '，|。|\n|！|「|」|、')
w.split <- strsplit(x = unlist(a.split), split = '')
n.gram.all <- sapply(w.split,function(e) ngram.func(e,i))
tb <- table(unlist(n.gram.all))
candidate <- names(tb[tb >= 4])
keywords <- c(keywords, candidate)
}
keywords
## [1] "物業開發" "北市府" "開發案" "轉投資" "雙子星" "00"
## [7] "公司" "北捷" "台北" "其他" "持股" "參與"
## [13] "開發" "管理"
關鍵字抓取
key <- worker('keywords', topn = 3)
key <= '自己常講幫助別人就是做功德的事'
## 11.7392 11.7392 11.7392
## "幫助" "別人" "常講"
a <- c('a')
abb <- c('a', 'b', 'b')
abc <- c('a', 'b', 'c')
D <- list(a,abb,abc)
# tfidf('a', a, D)
tf <- 1/1
idf <- log(3/3)
tf * idf
## [1] 0
# tfidf('a', abb, D)
tf <- 1 / 3
idf <- log(3/3)
tf * idf
## [1] 0
# tfidf('b', abb, D)
tf <- 2/3
idf <-log(3/2)
tf * idf
## [1] 0.2703101
# tfidf('a', abc, D)
tf <- 1/3
idf <- log(3/3)
tf * idf
## [1] 0
# tfidf('b', abc, D)
tf <- 1/3
idf <- log(3/2)
tf * idf
## [1] 0.135155
# tfidf('c', abc, D)
tf <- 1/3
idf <- log(3/1)
tf * idf
## [1] 0.3662041
sum(c('a', 'b', 'c') == 'a')
## [1] 1
sum(sapply(D, function(d) 'a' %in% d))
## [1] 3
tfidf <- function(t, d, D){
tf <- sum(d == t) / length(d)
idf <- log( length(D) / sum(sapply(D, function(doc) t %in% doc)) )
return(tf * idf)
}
tfidf('a', a, D)
## [1] 0
tfidf('a', abb, D)
## [1] 0
tfidf('a', abc, D)
## [1] 0
tfidf('b', abb, D)
## [1] 0.2703101
tfidf('b', abc, D)
## [1] 0.135155
tfidf('c', abc, D)
## [1] 0.3662041
Bag of Words
s <- "大巨蛋案對市府同仁下封口令？柯P否認"
#edit_dict()
mixseg <- worker()
segment(code= s , jiebar = mixseg)
## [1] "大巨蛋" "案對" "市府" "同仁" "下" "封口令" "柯P" "否認"
Building TermDocumentMatrix
library(tm)
## Warning: package 'tm' was built under R version 3.4.2
s <- 'Hello, I am david, I have taken over 100 courses'
s.split <- strsplit(s, ' ')
s.corpus <- Corpus(VectorSource(s.split))
dtm <- DocumentTermMatrix(s.corpus)
inspect(dtm)
## <<DocumentTermMatrix (documents: 1, terms: 7)>>
## Non-/sparse entries: 7/0
## Sparsity : 0%
## Maximal term length: 7
## Weighting : term frequency (tf)
## Sample :
## Terms
## Docs 100 courses david have hello over taken
## 1 1 1 1 1 1 1 1
dtm <- DocumentTermMatrix(s.corpus,
control = list(wordLengths = c(1,20)))
inspect(dtm)
## <<DocumentTermMatrix (documents: 1, terms: 10)>>
## Non-/sparse entries: 10/0
## Sparsity : 0%
## Maximal term length: 7
## Weighting : term frequency (tf)
## Sample :
## Terms
## Docs 100 am c courses david have hello i over taken
## 1 1 1 1 1 1 1 1 2 1 1
getTransformations()
## [1] "removeNumbers" "removePunctuation" "removeWords"
## [4] "stemDocument" "stripWhitespace"
doc <- tm_map(s.corpus, removeNumbers)
dtm <- DocumentTermMatrix(doc)
inspect(dtm)
## <<DocumentTermMatrix (documents: 1, terms: 6)>>
## Non-/sparse entries: 6/0
## Sparsity : 0%
## Maximal term length: 7
## Weighting : term frequency (tf)
## Sample :
## Terms
## Docs courses david have hello over taken
## 1 1 1 1 1 1 1
e1 <- 'this is a book'
e2 <- 'this is my car'
e.split <- strsplit(c(e1, e2), ' ')
e.corpus <- Corpus(VectorSource(e.split) )
dtm <- DocumentTermMatrix(e.corpus)
inspect(dtm)
## <<DocumentTermMatrix (documents: 2, terms: 3)>>
## Non-/sparse entries: 4/2
## Sparsity : 33%
## Maximal term length: 4
## Weighting : term frequency (tf)
## Sample :
## Terms
## Docs book car this
## 1 1 0 1
## 2 0 1 1
中文詞頻矩陣
library(jiebaR)
mixseg <- worker()
s <- "大巨蛋案對市府同仁下封口令？柯P否認"
s1 <- "柯P市府近來飽受大巨蛋爭議"
s.list <- lapply(list(s,s1), function(e) segment(e,jiebar = mixseg))
s.corpus <- Corpus(VectorSource(s.list))
s.dtm <- DocumentTermMatrix(s.corpus,
control = list(wordLengths=c(2,20)))
inspect(s.dtm)
## <<DocumentTermMatrix (documents: 2, terms: 9)>>
## Non-/sparse entries: 11/7
## Sparsity : 39%
## Maximal term length: 3
## Weighting : term frequency (tf)
## Sample :
## Terms
## Docs 下 大巨蛋 市府 同仁 爭議 近來 封口令 案對 飽受
## 1 1 1 1 1 0 0 1 1 0
## 2 0 1 1 0 1 1 0 0 1