前回の補足
フォームのリアクション制御: isolate()
server.R: isolate()
output$search <- renderTable({
input$update
res<-searchTwitter(isolate({input$keyword}), isolate({n=input$num}))
res <- sapply(res, function(x) x$getText())
cbind(res)
})
キャッシュの利用: memoise()
global.R: memoise()
getTweet <- memoise(function(term, num) {
res<-searchTwitter(term, n=num)
res <- sapply(res, function(x) x$getText())
return(res)
})
server.R: global.Rの関数を利用
output$search <- renderTable({
input$update
res<-getTweet(isolate({input$keyword}), isolate({n=input$num}))
cbind(res)
})
単語単位のn-gram
単語単位のリスト作成
test1<-"The meaning of Osaka University's motto"
wordLst <- strsplit(test1, "[[:space:]]|[[:punct:]]")
wordLst <- unlist(wordLst)
wordLst <- tolower(wordLst)
wordLst <- wordLst[wordLst != ""]
wordLst
## [1] "the" "meaning" "of" "osaka" "university"
## [6] "s" "motto"
単語単位のngram
size=3
start=1
wordLst[start:(start+size-1)]
## [1] "the" "meaning" "of"
strLst<-c()
len<-length(wordLst)-size+1
for(i in seq(1,len,size)) {
strLst<-rbind(strLst,wordLst[i:(i+size-1)])
}
strLst
## [,1] [,2] [,3]
## [1,] "the" "meaning" "of"
## [2,] "osaka" "university" "s"
RMecabによる日本語形態素解析
library("RMeCab")
wordLst<-unlist(RMeCabC(test2))
wordLst
## 名詞 助詞 記号 記号 名詞 助詞
## "大阪大学" "は" "、" "「" "大阪" "に"
## 助詞 名詞 名詞 助詞 記号 助詞
## "も" "帝国" "大学" "を" "」" "という"
## 名詞 名詞 名詞 助詞 名詞 助詞
## "地元" "大阪" "府民" "の" "熱意" "と"
## 記号 名詞 名詞 助詞 名詞 助詞
## "、" "関係" "者" "の" "努力" "により"
単語単位のngram:日本語(記号を除除)
wordLst <- wordLst[names(wordLst)!="記号"]
size=3
len<-length(wordLst)-size+1
strLst<-c()
for(i in seq(1,len,size)) {
strLst<-rbind(strLst,wordLst[i:(i+size-1)])
}
strLst
## 名詞 助詞 名詞
## [1,] "大阪大学" "は" "大阪"
## [2,] "に" "も" "帝国"
## [3,] "大学" "を" "という"
## [4,] "地元" "大阪" "府民"
## [5,] "の" "熱意" "と"
## [6,] "関係" "者" "の"
ネットワーク描画
使用データ
test1<-"Osaka University: The meaning of Osaka University's motto"
wordLst <- strsplit(test1, "[[:space:]]|[[:punct:]]")
wordLst <- unlist(wordLst)
wordLst <- tolower(wordLst)
wordLst <- wordLst[wordLst != ""]
size=3
step=2
strLst<-c()
len<-length(wordLst)-size+1
for(i in seq(1,len,step)) {
strLst<-rbind(strLst,wordLst[i:(i+size-1)])
}
strLst
## [,1] [,2] [,3]
## [1,] "osaka" "university" "the"
## [2,] "the" "meaning" "of"
## [3,] "of" "osaka" "university"
## [4,] "university" "s" "motto"
ペアデータの作成
一行のデータ
str<-strLst[1,]
pLst <- c()
for(i in 1:(length(str)-1)){
for(j in (i+1):length(str)){
tmp<-cbind(str[i],str[j])
pLst<-rbind(pLst,tmp)
}
}
pLst
## [,1] [,2]
## [1,] "osaka" "university"
## [2,] "osaka" "the"
## [3,] "university" "the"
関数の作成
getPairs<-function(str){
prLst<-c()
for(i in 1:(length(str)-1)){
for(j in (i+1):length(str)){
tmp<-cbind(str[i],str[j])
prLst<-rbind(prLst,tmp)
}
}
return(prLst)
}
getPairsLst<-function(strLst){
lst<-c()
for(i in 1:nrow(strLst)){
lst<-rbind(lst,getPairs(strLst[i,]))
}
return(lst)
}
ペアデータ
getPairs(strLst[1,])
## [,1] [,2]
## [1,] "osaka" "university"
## [2,] "osaka" "the"
## [3,] "university" "the"
getPairs(strLst[2,])
## [,1] [,2]
## [1,] "the" "meaning"
## [2,] "the" "of"
## [3,] "meaning" "of"
getPairsLst(strLst)
## [,1] [,2]
## [1,] "osaka" "university"
## [2,] "osaka" "the"
## [3,] "university" "the"
## [4,] "the" "meaning"
## [5,] "the" "of"
## [6,] "meaning" "of"
## [7,] "of" "osaka"
## [8,] "of" "university"
## [9,] "osaka" "university"
## [10,] "university" "s"
## [11,] "university" "motto"
## [12,] "s" "motto"
データフレーム型変換
paris<- data.frame(getPairsLst(strLst))
colnames(paris)<-c("Term1","Term2")
ペア頻度表
u<-unique(paris)
fMtx<-c()
for(i in 1:nrow(u)){
freq <-nrow(paris[paris$Term1==u$Term1[i] & paris$Term2==u$Term2[i],])
tmpRow <- cbind(as.character(u$Term1[i]), as.character(u$Term2[i]), freq)
fMtx <- rbind(fMtx,tmpRow)
}
fMtx<-data.frame(fMtx)
colnames(fMtx)<-c("Term1","Term2","Freq")
fMtx
## Term1 Term2 Freq
## 1 osaka university 2
## 2 osaka the 1
## 3 university the 1
## 4 the meaning 1
## 5 the of 1
## 6 meaning of 1
## 7 of osaka 1
## 8 of university 1
## 9 university s 1
## 10 university motto 1
## 11 s motto 1
igraphを利用した描画
library(igraph)
wng<-graph.data.frame(fMtx)
plot(wng)

igraphを利用した描画
wng<-as.undirected(graph.data.frame(fMtx))
plot(wng)

igraphを利用した描画
wng<-as.undirected(graph.data.frame(fMtx))
E(wng)$weight<-fMtx$Freq
deg<-degree(wng)
plot(wng,edge.width=E(wng)$weight,vertex.size=30*(deg/max(deg)))

netwkアプリケーションの起動(d3Networkを利用)
library(shiny)
runApp("netwk")