Update

egpivo · Nov 27, 2017 · f1ac90e · f1ac90e
1 parent fe29f9a
commit f1ac90e
Show file tree

Hide file tree

Showing 4 changed files with 30 additions and 9 deletions.
diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -1,6 +1,10 @@
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 
+tpmatrix <- function(P) {
+    .Call(`_SpatPCA_tpmatrix`, P)
+}
+
 tpm2 <- function(z, P, Phi) {
     .Call(`_SpatPCA_tpm2`, z, P, Phi)
 }

diff --git a/R/SpatPCA.R b/R/SpatPCA.R
@@ -33,13 +33,13 @@ spatpca <- function(x, Y, M = 5, K = NULL, K.select = ifelse(is.null(K),TRUE,FAL
   }else{ 
     ntau2 <- length(tau2)
   }
-  tempegvl <- svd(Y)
-  egvl <- tempegvl$d[1]^2 
+ # tempegvl <- svd(Y)
+#  egvl <- tempegvl$d[1]^2 
   if(is.null(tau1)) {
     ntau1 <- 11
-    max.tau1 <- egvl*sqrt(ncol(Y)/nrow(Y))
-    tau1 <- c(0,exp(seq(log(max.tau1/1e6), log(max.tau1), length = (ntau1-1))))   
-
+   # max.tau1 <- egvl*sqrt(ncol(Y)/nrow(Y))
+   # tau1 <- c(0,exp(seq(log(max.tau1/1e6), log(max.tau1), length = (ntau1-1))))   
+    tau1 <- c(0,exp(seq(log(1e-6), 0, length = (ntau1-1))))   
   }else{
     ntau1 <- length(tau1)
   }
@@ -57,6 +57,13 @@ spatpca <- function(x, Y, M = 5, K = NULL, K.select = ifelse(is.null(K),TRUE,FAL
     gamma <- c(0,exp(seq(log(gammamax1/1e4), log(gammamax1), length = gsize-1)))
   }
 
+  if(dim(x)[2] == 1){
+    min_x <- min(x)
+    max_x <- max(x)
+    x <- (x-min_x)/(max_x-min_x)
+    if(!is.null(x_new))
+      x_new <- (x_new-min_x)/(max_x-min_x)
+  }
 
   if(ntau2 ==1 && tau2 > 0){
     if(tau2 !=0)
@@ -102,9 +109,7 @@ spatpca <- function(x, Y, M = 5, K = NULL, K.select = ifelse(is.null(K),TRUE,FAL
 
   temp = eigenest_rcpp(est, Y, cvgamma, estfn)
   predict = temp$predict
-
-
-
+
   if(plot.cv == TRUE && !is.null(cv1)){
     if(ntau2 >1){
       par(mfrow=c(3,1))

diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
@@ -6,6 +6,17 @@
 
 using namespace Rcpp;
 
+// tpmatrix
+arma::mat tpmatrix(const arma::mat P);
+RcppExport SEXP _SpatPCA_tpmatrix(SEXP PSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< const arma::mat >::type P(PSEXP);
+    rcpp_result_gen = Rcpp::wrap(tpmatrix(P));
+    return rcpp_result_gen;
+END_RCPP
+}
 // tpm2
 arma::mat tpm2(const arma::mat z, const arma::mat P, const arma::mat Phi);
 RcppExport SEXP _SpatPCA_tpm2(SEXP zSEXP, SEXP PSEXP, SEXP PhiSEXP) {
@@ -56,6 +67,7 @@ END_RCPP
 }
 
 static const R_CallMethodDef CallEntries[] = {
+    {"_SpatPCA_tpmatrix", (DL_FUNC) &_SpatPCA_tpmatrix, 1},
     {"_SpatPCA_tpm2", (DL_FUNC) &_SpatPCA_tpm2, 3},
     {"_SpatPCA_spatpcacv2_rcpp", (DL_FUNC) &_SpatPCA_spatpcacv2_rcpp, 11},
     {"_SpatPCA_eigenest_rcpp", (DL_FUNC) &_SpatPCA_eigenest_rcpp, 4},

diff --git a/src/rcpp_SpatPCA.cpp b/src/rcpp_SpatPCA.cpp
@@ -73,7 +73,7 @@ struct tpm: public RcppParallel::Worker {
     }
   }
 };
-
+// [[Rcpp::export]]
 arma::mat tpmatrix(const arma::mat P){
   arma::mat L, Lp, Ip;
   int p = P.n_rows, d = P.n_cols;