ワード分析

あるサイトの文章を参考にサンプルしてみました。

```{r}

#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)

```

```{r}

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")
```

```{r}
#数量化４類

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)

```