expose penalty to curve alignment

NEWS.md

@@ -1,4 +1,5 @@
 # fdasrvf 2.0.2.900
+* exposed lam to curve functions
 
 # fdasrvf 2.0.2
 

R/curve_functions.R

@@ -224,7 +224,7 @@ find_rotation_seed_coord <- function(beta1, beta2, mode="O"){
 }
 
 
-find_rotation_seed_unqiue <- function(q1, q2, mode="O"){
+find_rotation_seed_unqiue <- function(q1, q2, mode="O", lam=0.0){
     n1 = nrow(q1)
     T1 = ncol(q1)
     scl = 4
@@ -251,7 +251,7 @@ find_rotation_seed_unqiue <- function(q1, q2, mode="O"){
             dim(q1i) = c(T1*n1)
             q2i = q2n
             dim(q2i) = c(T1*n1)
-            gam0 = .Call('DPQ', PACKAGE = 'fdasrvf', q1i, q2i, n1, T1, 0, 1, 0, rep(0,T1))
+            gam0 = .Call('DPQ', PACKAGE = 'fdasrvf', q1i, q2i, n1, T1, lam, 1, 0, rep(0,T1))
             gamI = invertGamma(gam0)
             gam = (gamI-gamI[1])/(gamI[length(gamI)]-gamI[1])
             beta2n = q_to_curve(q2n)

R/curve_karcher_mean.R

@@ -6,6 +6,7 @@
 #' @param mode Open ("O") or Closed ("C") curves
 #' @param rotated Optimize over rotation (default = T)
 #' @param scale Include scale (default = F)
+#' @param lambda A numeric value specifying the elasticity. Defaults to `0.0`.
 #' @param maxit maximum number of iterations
 #' @param ms string defining whether the Karcher mean ("mean") or Karcher median ("median") is returned (default = "mean")
 #' @return Returns a list containing \item{mu}{mean srvf}
@@ -28,7 +29,8 @@
 #' @examples
 #' out <- curve_karcher_mean(beta[, , 1, 1:2], maxit = 2)
 #' # note: use more shapes, small for speed
-curve_karcher_mean <- function (beta, mode = "O", rotated = T, scale = F, maxit = 20, ms = "mean")
+curve_karcher_mean <- function (beta, mode = "O", rotated = T, scale = F,
+                                lambda = 0.0, maxit = 20, ms = "mean")
 {
     if(ms!="mean"&ms!="median"){warning("ms must be either \"mean\" or \"median\". ms has been set to \"mean\"",immediate. = T)}
     if(ms!="median"){ms = "mean"}
@@ -75,7 +77,7 @@ curve_karcher_mean <- function (beta, mode = "O", rotated = T, scale = F, maxit
     cat("\nInitializing...\n")
     gam = matrix(0,T1,N)
     for (k in 1:N) {
-        out = find_rotation_seed_unqiue(mu,q[, , k],mode)
+        out = find_rotation_seed_unqiue(mu,q[, , k],mode,lambda)
         gam[,k] = out$gambest
     }
 
@@ -96,7 +98,7 @@ curve_karcher_mean <- function (beta, mode = "O", rotated = T, scale = F, maxit
         for (i in 1:N) {
             q1 = q[, , i]
 
-            out = find_rotation_seed_unqiue(mu,q1,mode)
+            out = find_rotation_seed_unqiue(mu,q1,mode,lambda)
             qn_t = out$q2best/sqrt(innerprod_q2(out$q2best,out$q2best))
 
             q1dotq2 = innerprod_q2(mu,qn_t)

R/curve_srvf_align.R

@@ -6,6 +6,7 @@
 #' @param mode Open ("O") or Closed ("C") curves
 #' @param rotated Optimize over rotation (default = T)
 #' @param scale Include scale (default = F)
+#' @param lambda A numeric value specifying the elasticity. Defaults to `0.0`.
 #' @param maxit maximum number of iterations
 #' @param ms string defining whether the Karcher mean ("mean") or Karcher median ("median") is returned (default = "mean")
 #' @return Returns a list containing \item{betan}{aligned curves}
@@ -18,15 +19,16 @@
 #' @examples
 #' data("mpeg7")
 #' out = curve_srvf_align(beta[,,1,1:2],maxit=2) # note: use more shapes, small for speed
-curve_srvf_align <- function(beta, mode="O", rotated=T, scale = F, maxit=20, ms = "mean"){
+curve_srvf_align <- function(beta, mode="O", rotated=T, scale = F, lambda = 0.0,
+                             maxit=20, ms = "mean"){
     if (mode=="C"){
       isclosed = TRUE
     }
     tmp = dim(beta)
     n = tmp[1]
     T1 = tmp[2]
     N = tmp[3]
-    out = curve_karcher_mean(beta, mode, rotated, scale, maxit, ms)
+    out = curve_karcher_mean(beta, mode, rotated, scale, lambda, maxit, ms)
     beta<-out$beta
     mu = out$mu
     betamean = out$betamean
@@ -35,24 +37,24 @@ curve_srvf_align <- function(beta, mode="O", rotated=T, scale = F, maxit=20, ms
 
     qn = array(0, c(n,T1,N))
     betan = array(0, c(n,T1,N))
-    rotmat = array(0, c(n,n,N)) 
-    gams = matrix(0, T1, N)     
- 
+    rotmat = array(0, c(n,n,N))
+    gams = matrix(0, T1, N)
+
     # align to mean
     for (ii in 1:N){
         q1 = q[,,ii]
         beta1 = beta[,,ii]
 
-        out = find_rotation_seed_unqiue(mu,q1,mode)
-        gams[,ii] = out$gambest 
+        out = find_rotation_seed_unqiue(mu,q1,mode,lambda)
+        gams[,ii] = out$gambest
         beta1 = out$Rbest%*%beta1
         beta1n = group_action_by_gamma_coord(beta1, out$gambest)
         q1n = curve_to_q(beta1n)$q
 
         out = find_best_rotation(mu, q1n)
         qn[,,ii] = out$q2new
         betan[,,ii] = out$R%*%beta1n
-        rotmat[,,ii] = out$R  
+        rotmat[,,ii] = out$R
     }
     return(list(betan=betan, qn=qn, betamean=betamean, q_mu=mu, rotmat = rotmat,gams = gams,v=v))
 }