allow for ANY as weight type backup for n_mean_var() (#19)

* allow for ANY as weight type backup

* update docs

* Increment version number to 0.8.0

* add MB as ctb

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: smd
 Type: Package
 Title: Compute Standardized Mean Differences
-Version: 0.7.0
+Version: 0.8.0
 Authors@R: c(person("Bradley", "Saul", role = c("aut", "cre"), 
                     email = "[email protected]"),
              person("Alex", "Breskin", role = c("ctb"), 
@@ -13,7 +13,9 @@ Authors@R: c(person("Bradley", "Saul", role = c("aut", "cre"),
              person("Daniel", "Sjoberg", role = c("ctb"),
                     email = "[email protected]"),
              person("Nuvan", "Rathnayaka", role = c("ctb"),
-                    email = "[email protected]")
+                    email = "[email protected]"),
+             person("Malcolm", "Barrett", role = c("ctb"), 
+                    email = "[email protected]")
              )
 Description: Computes standardized mean differences and confidence intervals for 
     multiple data types based on Yang, D., & Dalton, J. E. (2012) 

R/mean_var.R

@@ -19,7 +19,8 @@ multinom_var <- function(p) {
 #'
 #' @name n_mean_var
 #' @param x a vector of values
-#' @param w an optional vector of \code{numeric} weights
+#' @param w an optional vector of \code{numeric} weights or a vector convertible
+#'   with numeric with `as.double()`.
 #' @param na.rm passed to \code{sum}
 #' @param unwgt.var Use unweighted or weighted covariance matrix
 #' @importFrom stats var
@@ -90,6 +91,26 @@ setMethod(
   }
 )
 
+n_mean_var_any <- function(x, w, na.rm = FALSE, unwgt.var = TRUE) {
+  tryCatch({
+    w <- as.double(w)
+  }, 
+  warning = function(w) stop(
+    "A warning was emitted while converting weights to double: ",
+    w$message,
+    call. = FALSE
+  )
+  )
+
+  n_mean_var(x = x, w = w, na.rm = na.rm, unwgt.var = unwgt.var)
+}
+
+#' @rdname n_mean_var
+setMethod(
+  f = "n_mean_var",
+  signature = c("numeric", "ANY"),
+  definition = n_mean_var_any
+)
 
 #' @rdname n_mean_var
 setMethod(
@@ -111,6 +132,13 @@ setMethod(
   }
 )
 
+#' @rdname n_mean_var
+setMethod(
+  f = "n_mean_var",
+  signature = c("integer", "ANY"),
+  definition = n_mean_var_any
+)
+
 #' @rdname n_mean_var
 setMethod(
   f = "n_mean_var",
@@ -129,6 +157,13 @@ setMethod(
   }
 )
 
+#' @rdname n_mean_var
+setMethod(
+  f = "n_mean_var",
+  signature = c("logical", "ANY"),
+  definition = n_mean_var_any
+)
+
 #' @rdname n_mean_var
 setMethod(
   f = "n_mean_var",
@@ -167,6 +202,13 @@ setMethod(
   }
 )
 
+#' @rdname n_mean_var
+setMethod(
+  f = "n_mean_var",
+  signature = c("factor", "ANY"),
+  definition = n_mean_var_any
+)
+
 #' @rdname n_mean_var
 setMethod(
   f = "n_mean_var",
@@ -206,3 +248,10 @@ setMethod(
     n_mean_var(x, w, unwgt.var = unwgt.var)
   }
 )
+
+#' @rdname n_mean_var
+setMethod(
+  f = "n_mean_var",
+  signature = c("character", "ANY"),
+  definition = n_mean_var_any
+)

tests/testthat/test_mean_var.R

@@ -145,3 +145,22 @@ test_that("weighted n_mean_var with two-level x produces smd of 0", {
   expect_equal(res$mean[[1]], 0)
   expect_equal(res$mean[[2]], 1)
 })
+
+test_that("weighted n_mean_var works for custom vector class of weights", {
+  x <- c("Male", "Male", "Male")
+  x <- factor(x, levels = c("Female", "Male"))
+  w <- c(1, 1, 1)
+  class(w) <- "custom_vector"
+  res <- n_mean_var(x, w)
+  expect_equal(res$mean[[1]], 0)
+  expect_equal(res$mean[[2]], 1)
+})
+
+test_that("weighted n_mean_var errors when conversion fails", {
+  x <- 1:3
+  w <- c("a", "b", "c")
+  expect_error(
+    n_mean_var(x, w), 
+    "A warning was emitted while converting weights to double"
+  )
+})