R中的对称非负矩阵分解
我试图根据以下公式在R中实现NMF:R中的对称非负矩阵分解,r,R,我试图根据以下公式在R中实现NMF: H最初是猜测,然后根据此公式迭代更新。我写了这段代码,但它需要像以往一样执行。如何重写此代码?W是相似矩阵 sym.nmf <- function ( W ) { N <- ncol(W) set.seed(1234) H <- matrix(runif(N * k, 0, 1),N,k) J1 <- 0 while (0 < 1)
H最初是猜测,然后根据此公式迭代更新。我写了这段代码,但它需要像以往一样执行。如何重写此代码?W是相似矩阵
sym.nmf <- function ( W )
{
N <- ncol(W)
set.seed(1234)
H <- matrix(runif(N * k, 0, 1),N,k)
J1 <- 0
while (0 < 1)
{
HT <- t(H)
A <- W %*% H
B <- H %*% HT %*% H
H <- 0.5 * ( H * ( 1 + ( A / B )))
J = W - (H %*% t(H))
J = sum (J^2)
if ( (J1 != 0 ) && (J > J1) )
return (H1)
H1 <- H
J1 <- J
}
}
sym.nmf这里是对sym.nmf
函数的一次重做,在此过程中进行了一些统计上重要的改进和速度提升
当J[i]在J[i-1]的rel.tol
百分比范围内时,添加相对公差(rel.tol
)参数以中断循环。按照设置方式,只有当0==1或机器精度变得比拟合本身更可变时,才能停止循环。理论上,你的函数永远不会收敛
添加一个种子,因为再现性很重要。沿着这条路线,您可能会考虑使用非负双SVD进行初始化以获得领先。但是,根据您的应用情况,这可能会将NMF推到不代表全局极小值的局部极小值,因此可能是危险的。在我的例子中,我被锁定在一个类似SVD的极小值中,NMF最终在一个完全不同于随机初始化的因式分解的状态下收敛
添加最大迭代次数(max.iter
),因为有时您不想运行一百万次迭代来达到公差阈值
将基本的%*%
函数替换为crossprod
和tcrossprod
函数。这将根据矩阵大小获得大约2倍的速度增益
减少检查收敛的次数,因为在减去HH^T
后计算W
中的剩余信号需要将近一半的计算时间。您可以假设需要数百到数千次迭代才能收敛,所以只需每100个周期检查一次收敛性
更新的功能:
sym.nmf <- function (W, k, seed = 123, max.iter = 10000, rel.tol = 1e-10) {
set.seed(seed)
H <- matrix(runif(ncol(W) * k, 0, 1),ncol(W),k)
J <- c()
for(i in 1:max.iter){
H <- 0.5*(H*(1+(crossprod(W,H)/tcrossprod(H,crossprod(H)))))
# check for convergence every 100 iterations
if(i %% 100 == 0){
J <- c(J,sum((W - tcrossprod(H))^2))
plot(J, xlab = "iteration", ylab = "total residual signal", log = 'y')
cat("Iteration ",i,": J =",tail(J)[1],"\n")
if(length(J) > 3 && (1 - tail(J, 1)/tail(J, 2)[1]) < rel.tol){
return(H)
}
}
if(i == max.iter){
warning("Max.iter was reached before convergence\n")
return(H)
}
}
}
现在可以将该目标函数转换为Rcpp,以进一步提高速度。并行化还可以在目标函数内(并行化的crossprod
和tcrosprod
)或通过并行运行多个因子分解(因为通常需要多次重新启动才能发现稳健的解决方案)获得进一步的收益。有一个NMF
可以做到这一点,如果你不想重新发明轮子,如果你对方法感兴趣,@TomNash不幸的是,这是一种新方法,没有任何itI的实现,我看不到任何明显的缓慢,因此,如果您想要更高的速度,可能是时候查看rcpp
或类似的内容了。@Gregor矩阵W的维数较大时,速度较慢。在我的例子中是1500*1500。
sym.nmf <- function (W, k, seed = 123, max.iter = 100, rel.tol = 1e-10) {
set.seed(seed)
require(Rfast)
H <- matrix(runif(ncol(W) * k, 0, 1),ncol(W),k)
J <- c()
for(i in 1:max.iter){
H <- 0.5 * fit_H(W,H, num.iter = 100)
J <- c(J,sum((W - tcrossprod(H))^2))
plot(J, xlab = "iteration", ylab = "total residual signal", log = 'y')
cat("Iteration ",i,": J =",tail(J, n = 1),"\n")
if(length(J) > 3 && (1 - tail(J, 1)/tail(J, 2)[1]) < rel.tol){
return(H)
}
if(i == max.iter){
warning("Max.iter was reached before convergence\n")
return(H)
}
}
}
fit_H <- function(W,H, num.iter){
for(i in 1:num.iter){
H <- 0.5*(H*(1+(Rfast::Crossprod(W,H)/Rfast::Tcrossprod(H,Rfast::Crossprod(H,H)))))
}
H
}