Enforce sum constraint re issue #18 in as.theta.

R/as.theta.R

@@ -14,6 +14,7 @@
 #' Means on matrix form are as assumed to be \code{d} by \code{m}. I.e.
 #' rows correspond to the dimensions and columns to components, or the mean vectors
 #' as column vectors.
+#' Finally, the sum constriant of 1 for the mixture proportions is enforced.
 #'
 #' @param x A theta-like object that can be coerced.
 #' @return A theta object. See \code{\link{rtheta}}.
@@ -29,10 +30,11 @@
 #' theta <- as.theta(x)
 #' print(theta)
 #'
-#' x2 <- unname(list(
-#'   pie = c(0.5, 0.5),
-#'   mu = simplify2array(list(comp1=rep(0,d), comp2=rep(1,d))),
-#'   sigma = simplify2array(list(comp1=diag(d), comp2=diag(d)))
+#' x2 <- unname(list( # Unnamed
+#'   # missing m and d
+#'   pie = c(1, 1),   # Does not sum to 1
+#'   mu = simplify2array(list(comp1=rep(0,d), comp2=rep(1,d))), # matrix, not a list
+#'   sigma = simplify2array(list(comp1=diag(d), comp2=diag(d)))  # array, not a list
 #' ))
 #' theta2 <- as.theta(x2)
 #' print(theta2)
@@ -80,6 +82,12 @@ as.theta <- function(x) {
                         names = dimnames(x[[5]])[[3]])
   }
 
+  # Enforce sum contraint of pie to 1
+  if (!isTRUE(all.equal(sum(x$pie), 1))) {
+    x$pie <- x$pie/sum(x$pie)
+    warning("x$pie rescaled to enforce sum constraint of 1")
+  }
+
   if (is.theta(x)) {
     return(x)
   } else {

tests/testthat/test-as.theta.R

@@ -15,10 +15,13 @@ test_that("Check that as.theta works as intended", {
 
 # Coercion tests
 d <- 3
-x2 <- unname(list(
-  pie = c(0.5, 0.5),
-  mu = simplify2array(list(comp1 = rep(0,d), comp2 = rep(1,d))),
-  sigma = simplify2array(list(comp1 = diag(d), comp2 = diag(d)))
+x2 <- unname(list( # Unnamed
+  # missing m and d
+  pie = c(1, 1),   # Does not sum to 1
+  mu = simplify2array(list(comp1 = rep(0,d),
+                           comp2 = rep(1,d))), # matrix, not a list
+  sigma = simplify2array(list(comp1 = diag(d),
+                              comp2 = diag(d)))  # array, not a list
 ))
 
 test_that("Check that as.theta works for 'matrix means'", {