Forbid division by zero by catching too small weight vectors

R/block_project.R

@@ -15,7 +15,12 @@ block_project.block <- function(x) {
 #' @export
 block_project.dual_block <- function(x) {
   if (any(x$alpha != 0)) {
-    x$alpha <- x$alpha / drop(sqrt(t(x$alpha) %*% x$K %*% x$alpha))
+    alpha_norm <- t(x$alpha) %*% x$K %*% x$alpha
+    if (alpha_norm > 0) {
+      x$alpha <- x$alpha / drop(sqrt(alpha_norm))
+    } else {
+      x$alpha <- x$alpha * 0
+    }
   }
   x$a <- pm(t(x$x), x$alpha, na.rm = x$na.rm)
 
@@ -26,7 +31,12 @@ block_project.dual_block <- function(x) {
 #' @export
 block_project.primal_regularized_block <- function(x) {
   if (any(x$a != 0)) {
-    x$a <- x$M %*% x$a / drop(sqrt(t(x$a) %*% x$M %*% x$a))
+    a_norm <- sqrt(t(x$a) %*% x$M %*% x$a)
+    if (a_norm > 0) {
+      x$a <- x$M %*% x$a / drop(sqrt(a_norm))
+    } else {
+      x$a <- x$a * 0
+    }
   }
 
   x$Y <- pm(x$x, x$a, na.rm = x$na.rm)
@@ -36,9 +46,12 @@ block_project.primal_regularized_block <- function(x) {
 #' @export
 block_project.dual_regularized_block <- function(x) {
   if (any(x$alpha != 0)) {
-    x$alpha <- x$M %*% x$alpha / drop(sqrt(
-      t(x$alpha) %*% x$M %*% x$K %*% x$alpha
-    ))
+    alpha_norm <- t(x$alpha) %*% x$M %*% x$K %*% x$alpha
+    if (alpha_norm > 0) {
+      x$alpha <- x$M %*% x$alpha / drop(sqrt(alpha_norm))
+    } else {
+      x$alpha <- x$alpha * 0
+    }
   }
   x$a <- pm(t(x$x), x$alpha, na.rm = x$na.rm)