bugfixes for scaling

jdtuck · Feb 9, 2024 · cacbdde · cacbdde
1 parent fab8b9f
commit cacbdde
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 9 deletions.
diff --git a/R/curve_boxplot.R b/R/curve_boxplot.R
@@ -162,10 +162,8 @@ curvebox_data <- function(align_median, alpha = 0.05, ka = 1) {
     for (j in (i + 1):length(CR_50)) {
       q1 <- qn[, , CR_50[i]] - qmedian
       q3 <- qn[, , CR_50[j]] - qmedian
-      if (scale){
-        q1 <- q1 / sqrt(innerprod_q2(q1, q1))
-        q3 <- q3 / sqrt(innerprod_q2(q3, q3))
-      }
+      q1 <- q1 / sqrt(innerprod_q2(q1, q1))
+      q3 <- q3 / sqrt(innerprod_q2(q3, q3))
       angle[i, j] <- innerprod_q2(q1, q3)
       energy[i, j] <- (1 - lambda) * (dy[CR_50[i]] / m + dy[CR_50[j]] / m) -
         lambda * (angle[i, j] + 1)
@@ -192,10 +190,8 @@ curvebox_data <- function(align_median, alpha = 0.05, ka = 1) {
     for (j in (i + 1):length(CR_alpha)) {
       q1 <- qn[, , CR_alpha[i]] - qmedian
       q3 <- qn[, , CR_alpha[j]] - qmedian
-      if (scale){
-        q1 <- q1 / sqrt(innerprod_q2(q1, q1))
-        q3 <- q3 / sqrt(innerprod_q2(q3, q3))
-      }
+      q1 <- q1 / sqrt(innerprod_q2(q1, q1))
+      q3 <- q3 / sqrt(innerprod_q2(q3, q3))
       angle[i, j] <- innerprod_q2(q1, q3)
       energy[i, j] <- (1 - lambda) * (dy[CR_alpha[i]] / m + dy[CR_alpha[j]] / m) -
         lambda * (angle[i, j] + 1)

diff --git a/R/sample_shapes.R b/R/sample_shapes.R
@@ -24,6 +24,7 @@ sample_shapes <- function(x, no=3, numSamp=10){
 
     K <- curve_karcher_cov(x$v)
     mu <- x$mu
+    mu <- mu/sqrt(innerprod_q2(mu, mu))
 
     n = nrow(mu)
     T1 = ncol(mu)
@@ -46,6 +47,14 @@ sample_shapes <- function(x, no=3, numSamp=10){
     samples = array(0,dim=c(n,T1,numSamp))
     samples.q = array(0,dim=c(n,T1,numSamp))
 
+    # distribution if scales
+    scale = rep(1, numSamp)
+    scale_min = min(x$len_q)
+    scale_max = max(x$len_q)
+    if (!x$scale){
+      scale = runif(numSamp,scale_min,scale_max)
+    }
+
     for (i in 1:numSamp){
         v = matrix(0, 2, T1)
         for (m in 1:no){
@@ -72,7 +81,7 @@ sample_shapes <- function(x, no=3, numSamp=10){
             # q1 = q2
         }
 
-        beta = q_to_curve(q2)
+        beta = q_to_curve(q2, scale[i])
         centroid = calculatecentroid(beta)
         dim(centroid) = c(length(centroid),1)
         beta = beta - repmat(centroid,1,T1)