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

奇异值分解是一种矩阵分解技术，如果将列看作特征，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(nrow=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)

view raw svd.R hosted with ❤ by GitHub