奇异值分解和潜在语义分析

 奇异值分解是一种矩阵分解技术，如果将列看作特征，SVD也能看作是一种降维技术。如果将数据先进行标准化之后，再进行SVD操作，其左奇异向量U就是主成分得分，右奇异向量V就是主成分负载。但SVD的优势恰恰在于不进行标准化，当我们处理高维稀疏数据（例如文本数据）时，标准化会使矩阵不再稀疏，影响计算效率。

所以一般是用SVD直接对原始数据进行操作。得到U的第一列是平均值的意义，U的后几列才有区别各样本的功能。

在文本挖掘中，潜在语义分析（LSA）假设在词项和文档之间有一个潜在语义层，词汇和语义产生关联，文档也和语义产生关联。这样通过语义概念，可以将词项和文档放在一个语义空间中观察分析。进一步我们可以将语义所为词项的“主成分”放到数据挖掘中进行分析。

LSA的一般过程是先构造词项-文档矩阵（其转置为文档-词项矩阵，视需要而定），再计算TFIDF值，然后用SVD来分解这个矩阵，得到的奇异向量就是潜在语义。

U的第一列可以认为是词项在文档中的平均出现频率，V的第一列可以认为是文档中包含的词项频率，我们更有兴趣的是后几列。

关于SVD和LSA有一份精彩的入门文档，下面的R代码就是对该文档的模仿，但是SVD得到的结果却和文档不同，我很奇怪为什么会这样。

# 原始文件读入 
txt <- readLines('txtdm.txt') 
ignore = ",|:|!|'" 
stopwords = c('and','edition','for','in','little','of','the','to') 
txt <- tolower(txt) 
  
# 文档分词 
doc <- strsplit(txt,' ') 
# 去除常用词和标点 
doc <- lapply(doc,function(x)gsub(ignore,'',x)) 
doc <- lapply(doc,function(x){ 
  x[!(x %in% stopwords)]     
}) 
  
# 取词项集合 
words <- unique(unlist(doc)) 
  
# 计算词项文档矩阵 
DTM <- function(x,y){ 
  n <- length(x) 
  m <- length(y) 
  t <- matrix(nnrow=n,ncol=m) 
  for (i in 1:n){ 
    for (j in 1:m){ 
     t[i,j] <- sum(doc[[j]]==words[i]) 
    } 
  } 
  return(t) 
} 
t <- DTM(words,doc) 
  
# 只取同时出现在两个以上文档中的词项 
DocsPerWord <- rowSums(t>0)  
words <- words[DocsPerWord>1] 
t <- DTM(words,doc) 
  
# 将频数转为tfidf值 
TFIDF <- function(t){ 
  WordsPerDoc <- colSums(t)      
  DocsPerWord <- rowSums(t>0)  
  for (i in 1:nrow(t)){ 
    for (j in 1:ncol(t)){ 
      t[i,j] <- (t[i,j]/WordsPerDoc[j])*log(ncol(t)/DocsPerWord[i]) 
    } 
  } 
  return(t) 
} 
tfidf <- TFIDF(t) 
  
# SVD分解 
res <- svd(tfidf) 
# 词项语义相关矩阵 
datau <- data.frame(res$u[,2:3]) 
# 文档语义相关矩阵 
datav <- data.frame(res$v[,2:3]) 
  
library(ggplot2) 
p <- ggplot()+ 
  geom_point(data=datau,aes(X1,X2))+ 
  geom_point(data=datav,aes(X1,X2), 
             size=3,color='red4')+ 
  geom_text(data=datau,aes(X1,X2), 
            label=words,vjust=2)+ 
  geom_text(data=datav,aes(X1,X2), 
            label=1:9,vjust=2)+ 
  theme_bw() 
print(p)