X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=Rscripts%2Fanacor.R;h=a1441b97557415cd637cb0fc7c2e9c9bed6f67c0;hp=c68df778bb4db47538df619ad002a885fe0d2e41;hb=4c959afafbe1f1ec29b01fa8db3ae1af1b8cd4cf;hpb=8fa853a25a9d62b1446e1bc543e5a3a4d0e03dcf

diff --git a/Rscripts/anacor.R b/Rscripts/anacor.R
index c68df77..a1441b9 100644
--- a/Rscripts/anacor.R
+++ b/Rscripts/anacor.R
@@ -1,4 +1,3 @@
-print('NEW SVD')
 #################################################################################
 #http://www.mail-archive.com/rcpp-devel@lists.r-forge.r-project.org/msg01513.html
 
@@ -53,7 +52,7 @@ my.svd <- function(x, nu, nv, libsvdc.path=NULL, sparse.path=NULL) {
 ###################################################################################
 
 #from anacor package
-boostana<-function (tab, ndim = 2, libsvdc = FALSE, libsvdc.path=NULL) 
+boostana<-function (tab, ndim = 2, svd.method = 'svdR', libsvdc.path=NULL) 
 {
     #tab <- as.matrix(tab)
     if (ndim > min(dim(tab)) - 1) 
@@ -76,7 +75,7 @@ boostana<-function (tab, ndim = 2, libsvdc = FALSE, libsvdc.path=NULL)
     z1 <- t(tab)/sqrt(c)
     z2 <- tab/sqrt(r)
     z <- t(z1) * z2
-    if (libsvdc) {
+    if (svd.method == 'svdlibc') {
         #START NEW SVD
         z <- as(z, "dgCMatrix")
         tmpmat <- tempfile(pattern='sparse')
@@ -85,10 +84,14 @@ boostana<-function (tab, ndim = 2, libsvdc = FALSE, libsvdc.path=NULL)
         print('do svd')
         sv <- my.svd(z, qdim, qdim, libsvdc.path=libsvdc.path, sparse.path=tmpmat)
         #END NEW SVD
-    } else {
+    } else if (svd.method == 'svdR') {
         print('start R svd')
         sv <- svd(z, nu = qdim, nv = qdim) 
         print('end svd')
+    } else if (svd.method == 'irlba') {
+        print('irlba')
+        sv <- irlba(z, qdim, qdim)
+        print('end irlba')
     }
     sigmavec <- (sv$d)[2:qdim]
 	x <- ((sv$u)/sqrt(r))[, -1]