switching to devel

R/bfpca.R

@@ -14,8 +14,6 @@
 #' @param print.iter Prints current error and iteration
 #' @param row_obj If NULL, the function cleans the data and calculates row indices. 
 #' Keep this NULL if you are using standalone \code{register} function.
-#' @param phi_coefs B-spline basis coefficients for alpha and psi 
-#' from previous iteraction of \code{registration_fpca()}, used for initializing parameters.
 #' @param seed Set seed for reproducibility. Default is 1988.
 #' @param ... Additional arguments passed to or from other functions
 #' 
@@ -35,7 +33,6 @@
 #' with \code{refund.shiny} package.}
 #' \item{subject_coefs}{B-spline basis coefficients used to construct subject-specific means. 
 #' For use in \code{registr()} function.}
-#' \item{phi_coefs}{B-spline basis coefficients for alpha and psi.}
 #' \item{Yhat}{FPC approximation of subject-specific means.}
 #' \item{Y}{The observed data.}
 #' \item{family}{\code{binomial}, for compatibility with \code{refund.shiny} package.}
@@ -56,7 +53,7 @@
 ##' }
 #'
 bfpca <- function(Y, npc = 1, Kt = 8, maxiter = 50, t_min = NULL, t_max = NULL, 
-                  print.iter = FALSE, row_obj= NULL, phi_coefs = NULL,
+                  print.iter = FALSE, row_obj= NULL,
 									seed = 1988, ...){
 
   curr_iter = 1
@@ -95,14 +92,8 @@ bfpca <- function(Y, npc = 1, Kt = 8, maxiter = 50, t_min = NULL, t_max = NULL,
   ## initialize all your vectors
   set.seed(seed)
   xi = matrix(rnorm(dim(Y)[1]), ncol = 1) * 0.5
-
-  if(is.null(phi_coefs)){
-  	alpha_coefs = matrix(coef(glm(Y$value ~ 0 + Theta_phi, family = "binomial")), Kt, 1)
-  	psi_coefs = matrix(rnorm(Kt * npc), Kt, npc) * 0.5
-  }else{
-  	alpha_coefs = phi_coefs[, npc+1]
-  	psi_coefs = phi_coefs[, 1:npc]
-  }
+  alpha_coefs = matrix(coef(glm(Y$value ~ 0 + Theta_phi, family = "binomial")), Kt, 1)
+  psi_coefs = matrix(rnorm(Kt * npc), Kt, npc) * 0.5
 
   temp_alpha_coefs = alpha_coefs
   temp_psi_coefs = psi_coefs
@@ -199,7 +190,6 @@ bfpca <- function(Y, npc = 1, Kt = 8, maxiter = 50, t_min = NULL, t_max = NULL,
     "npc" = npc,
     "scores" = scores,
     "subject_coefs" = subject_coef,
-   	"phi_coefs" = phi_mat,
     "Yhat" = fittedVals, 
     "Y" = Y, 
     "family" = "binomial",

R/register_fpca.R

@@ -71,11 +71,9 @@ register_fpca <- function(Y, Kt = 8, Kh = 4, family = "binomial", max_iterations
   	message("current iteration: ", iter)
 
   	if(family == "binomial"){
-  		fpca_step = bfpca(registr_step$Y, npc = npc, Kt = Kt, row_obj = rows, 
-  											phi_coefs = NULL, seed = 1988 + iter, ...)
+  		fpca_step = bfpca(registr_step$Y, npc = npc, Kt = Kt, row_obj = rows, seed = 1988 + iter, ...)
   	}else if(family == "gaussian"){
-  		fpca_step = fpca_gauss(registr_step$Y, npc = npc, Kt = Kt, row_obj = rows, 
-  													 phi_coefs = NULL, seed = 1988 + iter, ...)
+  		fpca_step = fpca_gauss(registr_step$Y, npc = npc, Kt = Kt, row_obj = rows, seed = 1988 + iter, ...)
   	}
 
   	registr_step = registr(obj = fpca_step, Kt = Kt, Kh = Kh, family = family, 
@@ -91,11 +89,9 @@ register_fpca <- function(Y, Kt = 8, Kh = 4, family = "binomial", max_iterations
 
   # final fpca step
   if(family == "binomial"){
-  	fpca_step = bfpca(registr_step$Y,npc = npc, Kt = Kt, row_obj = rows,
-  										phi_coefs = NULL)
+  	fpca_step = bfpca(registr_step$Y,npc = npc, Kt = Kt, row_obj = rows)
   }else if(family == "gaussian"){
-  	fpca_step = fpca_gauss(registr_step$Y,npc = npc, Kt = Kt, row_obj = rows,
-  												 phi_coefs = NULL)
+  	fpca_step = fpca_gauss(registr_step$Y,npc = npc, Kt = Kt, row_obj = rows)
   }
 
   Y$tstar = time_warps[[1]]

tests/testthat/test-bfpca.R

@@ -72,8 +72,6 @@ test_that("bfpca works for different start seeds",{
 test_that("bfpca iterations are strictly decreasing",{
 	Y = simulate_functional_data()$Y
 	bfpca_object = bfpca(Y, npc = 2, print.iter = TRUE)
-	bfpca_object = bfpca(Y, npc = 2, print.iter = TRUE,
-											 phi_coefs = bfpca_object$phi_coefs)
 
-	#expect_true(all(diff(bfpca_object$error) < 0))
+	expect_true(all(diff(bfpca_object$error) < 0))
 })