From 110f44744ae518b557075ca771d03ad2632433fd Mon Sep 17 00:00:00 2001 From: Malcolm Barrett Date: Mon, 3 Feb 2025 13:20:33 -0500 Subject: [PATCH] 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 | 6 ++-- R/mean_var.R | 51 +++++++++++++++++++++++++++++++++- man/n_mean_var.Rd | 18 +++++++++++- tests/testthat/test_mean_var.R | 19 +++++++++++++ 4 files changed, 90 insertions(+), 4 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 25be269..07f54b2 100644 --- a/DESCRIPTION +++ b/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 = "bradleysaul@fastmail.com"), 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 = "danield.sjoberg@gmail.com"), person("Nuvan", "Rathnayaka", role = c("ctb"), - email = "nuvanrath@proton.me") + email = "nuvanrath@proton.me"), + person("Malcolm", "Barrett", role = c("ctb"), + email = "malcolmbarrett@gmail.com") ) Description: Computes standardized mean differences and confidence intervals for multiple data types based on Yang, D., & Dalton, J. E. (2012) diff --git a/R/mean_var.R b/R/mean_var.R index 3ffbeed..d5e8dcc 100644 --- a/R/mean_var.R +++ b/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 +) diff --git a/man/n_mean_var.Rd b/man/n_mean_var.Rd index c415090..49b2194 100644 --- a/man/n_mean_var.Rd +++ b/man/n_mean_var.Rd @@ -4,14 +4,19 @@ \alias{n_mean_var} \alias{n_mean_var,numeric,missing-method} \alias{n_mean_var,numeric,numeric-method} +\alias{n_mean_var,numeric,ANY-method} \alias{n_mean_var,integer,missing-method} \alias{n_mean_var,integer,numeric-method} +\alias{n_mean_var,integer,ANY-method} \alias{n_mean_var,logical,missing-method} \alias{n_mean_var,logical,numeric-method} +\alias{n_mean_var,logical,ANY-method} \alias{n_mean_var,factor,missing-method} \alias{n_mean_var,factor,numeric-method} +\alias{n_mean_var,factor,ANY-method} \alias{n_mean_var,character,missing-method} \alias{n_mean_var,character,numeric-method} +\alias{n_mean_var,character,ANY-method} \title{Compute n, mean and variance} \usage{ n_mean_var(x, w = NULL, na.rm = FALSE, unwgt.var = TRUE) @@ -20,26 +25,37 @@ n_mean_var(x, w = NULL, na.rm = FALSE, unwgt.var = TRUE) \S4method{n_mean_var}{numeric,numeric}(x, w = NULL, na.rm = FALSE, unwgt.var = TRUE) +\S4method{n_mean_var}{numeric,ANY}(x, w = NULL, na.rm = FALSE, unwgt.var = TRUE) + \S4method{n_mean_var}{integer,missing}(x, w = NULL, na.rm = FALSE, unwgt.var = TRUE) \S4method{n_mean_var}{integer,numeric}(x, w = NULL, na.rm = FALSE, unwgt.var = TRUE) +\S4method{n_mean_var}{integer,ANY}(x, w = NULL, na.rm = FALSE, unwgt.var = TRUE) + \S4method{n_mean_var}{logical,missing}(x, na.rm = FALSE, unwgt.var = TRUE) \S4method{n_mean_var}{logical,numeric}(x, w = NULL, na.rm = FALSE, unwgt.var = TRUE) +\S4method{n_mean_var}{logical,ANY}(x, w = NULL, na.rm = FALSE, unwgt.var = TRUE) + \S4method{n_mean_var}{factor,missing}(x, w = NULL, na.rm = FALSE, unwgt.var = TRUE) \S4method{n_mean_var}{factor,numeric}(x, w = NULL, na.rm = FALSE, unwgt.var = TRUE) +\S4method{n_mean_var}{factor,ANY}(x, w = NULL, na.rm = FALSE, unwgt.var = TRUE) + \S4method{n_mean_var}{character,missing}(x, w = NULL, na.rm = FALSE, unwgt.var = TRUE) \S4method{n_mean_var}{character,numeric}(x, w = NULL, na.rm = TRUE, unwgt.var = TRUE) + +\S4method{n_mean_var}{character,ANY}(x, w = NULL, na.rm = FALSE, unwgt.var = TRUE) } \arguments{ \item{x}{a vector of values} -\item{w}{an optional vector of \code{numeric} weights} +\item{w}{an optional vector of \code{numeric} weights or a vector convertible +with numeric with `as.double()`.} \item{na.rm}{passed to \code{sum}} diff --git a/tests/testthat/test_mean_var.R b/tests/testthat/test_mean_var.R index b4c1740..cadc2ea 100644 --- a/tests/testthat/test_mean_var.R +++ b/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" + ) +})