From d02b3efddab839b9071a259bf6e08fe81760d549 Mon Sep 17 00:00:00 2001 From: gravesti Date: Mon, 21 Aug 2023 15:18:49 +0200 Subject: [PATCH] partly fix docs --- NAMESPACE | 1 - R/matching.R | 38 ++++++++++++++++++++++----------- man/calculate_weights_legend.Rd | 5 ++++- man/check_weights.Rd | 2 +- man/ess_footnote_text.Rd | 1 + tests/testthat/test-matching.R | 15 +++++++++++++ 6 files changed, 46 insertions(+), 16 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index d4390c69..90dbd626 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,7 +3,6 @@ S3method(plot,maicplus_estimate_weights) S3method(print,maicplus_check_weights) export(bucher) -export(calculate_weights_legend) export(center_ipd) export(check_weights) export(dummize_ipd) diff --git a/R/matching.R b/R/matching.R index 6a5582f1..1f7757d9 100644 --- a/R/matching.R +++ b/R/matching.R @@ -109,7 +109,7 @@ estimate_weights <- function(data, centered_colnames = NULL, start_val = 0, meth } -#' Plot MAIC weights in a histogram with key statistics in legend +#' Calculate Statistics for Weight Plot Legend #' #' Calculates ESS reduction and median weights which is used to create legend for weights plot #' @@ -117,11 +117,15 @@ estimate_weights <- function(data, centered_colnames = NULL, start_val = 0, meth #' #' @return list of ESS, ESS reduction, median value of scaled and unscaled weights, and missing count #' @examples +#' \dontrun{ #' load(system.file("extdata", "weighted_data.rda", package = "maicplus", mustWork = TRUE)) #' calculate_weights_legend(weighted_data) -#' @export - +#' } +#' @keywords internal calculate_weights_legend <- function(weighted_data) { + if (!inherits(weighted_data, "maicplus_estimate_weights")) { + stop("weighted_data must be class `maicplus_estimate_weights` generated by estimate_weights()") + } ess <- weighted_data$ess wt <- weighted_data$data$weights wt_scaled <- weighted_data$data$scaled_weights @@ -241,7 +245,10 @@ plot_weights_ggplot <- function(weighted_data, bin_col, vline_col, ) + ggplot2::theme_bw() + ggplot2::facet_wrap(~ind, nrow = 1) + - ggplot2::geom_text(data = legend_data, ggplot2::aes_string(label = "lab"), x = Inf, y = Inf, hjust = 1, vjust = 1, size = 3) + + ggplot2::geom_text( + data = legend_data, + ggplot2::aes_string(label = "lab"), x = Inf, y = Inf, hjust = 1, vjust = 1, size = 3 + ) + ggplot2::theme( axis.title = ggplot2::element_text(size = 12), axis.text = ggplot2::element_text(size = 12) @@ -300,16 +307,13 @@ plot.maicplus_estimate_weights <- function(x, ggplot = FALSE, #' This function checks to see if the optimization is done properly by checking the covariate averages #' before and after adjustment. #' -#' @param match_res object returned after calculating weights using \code{\link{estimate_weights}} +#' @param weighted_data object returned after calculating weights using \code{\link{estimate_weights}} #' @param processed_agd a data frame, object returned after using \code{\link{process_agd}} or #' aggregated data following the same naming convention -#' @param mean_digits number of digits for rounding mean columns in the output -#' @param prop_digits number of digits for rounding proportion columns in the output -#' @param sd_digits number of digits for rounding mean columns in the output #' #' @examples #' load(system.file("extdata", "agd.rda", package = "maicplus", mustWork = TRUE)) -#' load(system.file("extdata", "match_res.rda", package = "maicplus", mustWork = TRUE)) +#' load(system.file("extdata", "weighted_data.rda", package = "maicplus", mustWork = TRUE)) #' outdata <- check_weights(match_res, processed_agd = agd) #' print(outdata) #' @@ -337,7 +341,8 @@ check_weights <- function(weighted_data, processed_agd) { sum_centered_IPD_with_weights = as.vector(num_check) ) attr(outdata, "footer") <- list() - ind_mean <- lapply(outdata$covariate, grep, x = names(processed_agd), value = TRUE) # find item that was matched by mean + # find item that was matched by mean + ind_mean <- lapply(outdata$covariate, grep, x = names(processed_agd), value = TRUE) ind_mean <- sapply(ind_mean, function(ii) any(grepl("_MEAN$", ii))) outdata$match_stat <- ifelse(grepl("_MEDIAN$", outdata$covariate), "Median", ifelse(grepl("_SQUARED$", outdata$covariate), "SD", @@ -353,7 +358,10 @@ check_weights <- function(weighted_data, processed_agd) { covname <- outdata$covariate[ii] if (outdata$match_stat[ii] %in% c("Mean", "Prop")) { outdata$internal_trial[ii] <- mean(ipd_with_weights[[covname]], na.rm = TRUE) - outdata$internal_trial_after_weighted[ii] <- weighted.mean(ipd_with_weights[[covname]], w = ipd_with_weights$weights, na.rm = TRUE) + outdata$internal_trial_after_weighted[ii] <- weighted.mean( + ipd_with_weights[[covname]], + w = ipd_with_weights$weights, na.rm = TRUE + ) } else if (outdata$match_stat[ii] == "Median") { outdata$internal_trial[ii] <- quantile(ipd_with_weights[[covname]], probs = 0.5, @@ -402,7 +410,11 @@ check_weights <- function(weighted_data, processed_agd) { #' @describeIn check_weights Print method for check_weights objects #' @export -print.maicplus_check_weights <- function(x, mean_digits = 2, prop_digits = 2, sd_digits = 3, digits = getOption("digits"), ...) { +print.maicplus_check_weights <- function(x, + mean_digits = 2, + prop_digits = 2, + sd_digits = 3, + digits = getOption("digits"), ...) { round_digits <- c("Mean" = mean_digits, "Prop" = prop_digits, "SD" = sd_digits)[x$match_stat] round_digits[is.na(round_digits)] <- digits @@ -425,7 +437,7 @@ print.maicplus_check_weights <- function(x, mean_digits = 2, prop_digits = 2, sd #' @param width Number of characters to break string into new lines (`\n`). #' #' @return A character string - +#' @keywords internal ess_footnote_text <- function(width = 0.9 * getOption("width")) { text <- "An ESS reduction up to ~60% is not unexpected based on the 2021 survey of NICE's technology appraisals (https://onlinelibrary.wiley.com/doi/full/10.1002/jrsm.1511), whereas a reduction of >75% is less common diff --git a/man/calculate_weights_legend.Rd b/man/calculate_weights_legend.Rd index fe9b1061..d9078b88 100644 --- a/man/calculate_weights_legend.Rd +++ b/man/calculate_weights_legend.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/matching.R \name{calculate_weights_legend} \alias{calculate_weights_legend} -\title{Plot MAIC weights in a histogram with key statistics in legend} +\title{Calculate Statistics for Weight Plot Legend} \usage{ calculate_weights_legend(weighted_data) } @@ -16,6 +16,9 @@ list of ESS, ESS reduction, median value of scaled and unscaled weights, and mis Calculates ESS reduction and median weights which is used to create legend for weights plot } \examples{ +\dontrun{ load(system.file("extdata", "weighted_data.rda", package = "maicplus", mustWork = TRUE)) calculate_weights_legend(weighted_data) } +} +\keyword{internal} diff --git a/man/check_weights.Rd b/man/check_weights.Rd index d79a833d..e1f45f28 100644 --- a/man/check_weights.Rd +++ b/man/check_weights.Rd @@ -48,7 +48,7 @@ before and after adjustment. }} \examples{ load(system.file("extdata", "agd.rda", package = "maicplus", mustWork = TRUE)) -load(system.file("extdata", "match_res.rda", package = "maicplus", mustWork = TRUE)) +load(system.file("extdata", "weighted_data.rda", package = "maicplus", mustWork = TRUE)) outdata <- check_weights(match_res, processed_agd = agd) print(outdata) diff --git a/man/ess_footnote_text.Rd b/man/ess_footnote_text.Rd index 016087c4..4ff311cf 100644 --- a/man/ess_footnote_text.Rd +++ b/man/ess_footnote_text.Rd @@ -15,3 +15,4 @@ A character string \description{ Note on Expected Sample Size Reduction } +\keyword{internal} diff --git a/tests/testthat/test-matching.R b/tests/testthat/test-matching.R index 2c566834..e7327211 100644 --- a/tests/testthat/test-matching.R +++ b/tests/testthat/test-matching.R @@ -8,3 +8,18 @@ test_that("ess_footnote_text works", { ) ) }) + +test_that("calculate_weights_legend works", { + load(system.file("extdata", "weighted_data.rda", package = "maicplus", mustWork = TRUE)) + result <- calculate_weights_legend(weighted_data) + expect_equal( + result, + expected = list( + ess = 166.37, + ess_reduction = 66.73, + wt_median = 0.0594, + wt_scaled_median = 0.1486, + nr_na = 0L + ) + ) +})