あるサイトの文章を参考にサンプルしてみました。
#naive_bayes
library(dplyr);library(RMeCab)
sentence1=c("特に、理工系の研究報告書の添削や投稿論文の査読などをしていると、日本語に関して、その
“曖昧さ”に助けられて、“自分本位”の難解な文章になっていることが多く見受けられます。
何とも日本語の間違いが多く、筆者があまりにもそのことに注意を払っていないのに驚きます。
自分では真面目に熱のこもった文章を書いているし、他人に指摘されることが嫌になるくらいの
思い入れがあるのは伝わってきます。でも、他人が読むとさっぱり分からないのです。実は、そ
んな文章は、しばらくして筆者自身が読んでもさっぱり分からないものです。これは決して専門
用語が分からないからではなく、日本語が下手で幼稚だからです。いわゆるこれが「稚拙な文章」
というものです。
この独りよがりで、しかも専門用語が混じっているような一般には“理解されない”文章を、
「いかに短い文章」で「正確に」伝えられるか。文章は理解されなくては意味がありません。こ
のリポートは、ちょっとインテリジェンスな人を相手に、スマートに理解してもらうための文書
作成アドバイスです。")
write.table(sentence1,"~/txt.txt")
words1=RMeCabFreq("txt.txt")
words1=words1 %>% filter(Info1 %in% c("名詞","動詞","副助詞"))
sentences1=unlist(strsplit(sentence1,"。"))
res1=NgramDF("txt.txt",type=1,N=2,pos=c("名詞","動詞","形容詞"))
sentence2=c("733年の成立と言われる『出雲国風土記（いずものくにふどき）』には、現在の島根県の玉造（たまつくり）温泉のことが次のように記されている。
「この里の川辺には温泉が湧いている。この温泉の出る所はちょうど海陸の景勝を兼ねた所であって、男も女も、老人も、若者も、あるいは道路を往復し、あるいは海上を浜辺に沿って行き、毎日のように集まって市場（いちば）のような賑わいをなし、また、入りみだれて酒宴を楽しんだりしている。そしてこの温泉で一度洗えば容貌も美しくなり、重ねて洗えば万病すべて治癒してしまう。このように、昔から今まで例外なく効験を得ているので、世の人たちはこれを神の湯と言っている」
この記述から、古代の日本人にとって温泉がどのような存在であったのか、なぜ日本人が温泉を愛するようになったのかが伺える。一度温泉に入ると容姿端麗になり、もう一度入るとどんな病気も治癒してしまう―。今から1300年近くも前に書かれたこの言葉は、温泉の本質を突いている。化粧品や医薬品がなかった時代、この表現は決して誇張されたものではなかったはずだ。")
write.table(sentence2,"~/txt.txt")
words2=RMeCabFreq("txt.txt")
words2=words2 %>% filter(Info1 %in% c("名詞","動詞","副助詞"))
sentences2=unlist(strsplit(sentence2,"。"))
res2=NgramDF("txt.txt",type=1,N=2,pos=c("名詞","動詞","形容詞"))
#正規分布
words1=words1 %>% mutate(class=1)
words2=words2 %>% mutate(class=2)
words=rbind(words1,words2)
test=c("赤這温泉「阿部旅館」
大好きな阿部旅館から湯めぐり開始。奥は鉄臭香る茶色い湯、手前は硫黄臭香る青みがかった湯。どちらもドバドバと投入され新鮮さが堪らない。ずっと入っていられる気持ち良さ。強すぎず弱すぎず、自分の肌にとても合う阿部旅館のお湯。何度でも入りたくなる極上湯です。 ")
write.table(test,"~/txt.txt")
test_words=RMeCabFreq("txt.txt")
test_words=test_words %>% filter(Info1 %in% c("名詞","動詞","副助詞"))
tes_words=test_words$Term
res_test=NgramDF("txt.txt",type=1,N=2,pos=c("名詞","動詞","形容詞"))
result=data.frame(tes_words=tes_words,freq1=0,freq2=0,density1=0,density2=0,test_freq=0)
density1=c();density2=c()
test_freq=test_words$Freq/sum(test_words$Freq)
for(j in 1:length(tes_words)){
word=tes_words[j]
val=test_words$Freq[j]
if(sum(words1$Term %in% word)>0){
clas_freq1=words1$Freq[words1$Term==word]
}else{
clas_freq1=0
}
if(sum(words2$Term %in% word)>0){
clas_freq2=words2$Freq[words2$Term==word]
}else{
clas_freq2=0
}
result$density1[j]=ifelse(clas_freq1>0,test_freq[j],0)
result$density2[j]=ifelse(clas_freq2>0,test_freq[j],0)
result$freq1[j]=clas_freq1
result$freq2[j]=clas_freq2
result$test_freq[j]=val
}
test_words=test_words %>% mutate(class=3)
all_words=rbind(words,test_words)
word=unique(all_words$Term)
word_clas=data.frame(word=word,class1=0,class2=0,class3=0)
for(j in 1:nrow(word_clas)){
term=word[j]
word_clas$class1[j]=ifelse(sum(words1$Term %in% term)>0,words1$Freq[words1$Term==term],0)
word_clas$class2[j]=ifelse(sum(words2$Term %in% term)>0,words2$Freq[words2$Term==term],0)
word_clas$class3[j]=ifelse(sum(test_words$Term %in% term)>0,test_words$Freq[test_words$Term==term],0)
}
A=as.matrix(word_clas[,2:ncol(word_clas)])
sigma=svd(A)$d
U=svd(A)$u;V=svd(A)$v
P=A
N=ncol(P)
for(j in 1:nrow(P)){
P[j,]=P[j,]/sum(P[j,])
}
C=apply(A,2,sum)
L=log(1+A/C)
#類似度S
S=A%*%t(A)
diag_data=data.frame(num=1:nrow(S),val=diag(S)) %>% mutate(sign=ifelse(val<5,0,1))
rownames(S)=word;colnames(S)=word
nums=diag_data$num[diag_data$sign==1]
S=S[nums,nums]
#write.csv(S,"~/S.csv")
d=apply(S,1,sum)
D=diag(d)
L=D-S
L_hat=diag(1,length(d))-solve(D)%*%S
L=L_hat
eigen_values=eigen(L)$values
eigen_vectors=eigen(L)$vectors
X=eigen_vectors[,(length(eigen_values)-2):length(eigen_values)]
rownames(X)=rownames(S)
word_vec=rownames(S)
clust_result=data.frame(word=word_vec,X) %>% mutate(class=kmeans(X,10)$cluster)
write.csv(clust_result,"~/clust_result.csv")
dist=array(0,dim=c(nrow(X),nrow(X)))
rownames(dist)=rownames(S);colnames(dist)=rownames(S)
for(j in 1:nrow(dist)){
for(i in 1:ncol(dist)){
dist[j,i]=sum(abs(X[j,]-X[i,]))
}
}
#write.csv(dist,"~/dist.csv")
#数量化４類
e=S
#e=e+t(e)
H=array(0,dim=c(nrow(e),ncol(e)))
for(j in 1:nrow(H)){
for(i in 1:ncol(H)){
if(j!=i){
H[j,i]=e[i,j]+e[j,i]
}
}
}
alpha=-max(H)
H=H+alpha;diag(H)=0
for(j in 1:ncol(H)){
diag(H)[j]=-sum(H[j,])
}
X=eigen(H)$vectors[,1];Y=eigen(H)$vectors[,2]
lambda=eigen(H)$values[1];mu=eigen(H)$values[2]
Q=lambda*sum(X^2)+mu*sum(Y^2)
print(t(X)%*%H%*%X+t(Y)%*%H%*%Y)
plot(-X,Y,type="p",xlab="X",ylab="Y",col=2)
lambda2_n1=eigen(H)$values[length(eigen(H)$values)-1]
lambda_hats=eigen(H)$values[1:(length(eigen(H)$values)-2)]
propotion=(lambda_hats-lambda2_n1)/(sum(lambda_hats)-(length(eigen(H)$values)-2)*lambda2_n1)
cumsum_prop=cumsum(propotion)
Z=cbind(X,Y)
X=eigen(H)$vectors[,1:4]
eigen_vectors=data.frame(num=1:nrow(X),word=rownames(S),X) %>% mutate(class=kmeans(X,10)$cluster)