From d49439bc2510ea81f2b4e5c6a8f679a871ae82ba Mon Sep 17 00:00:00 2001 From: naeemkh Date: Wed, 14 Feb 2024 18:15:00 -0500 Subject: [PATCH] fix examples --- NAMESPACE | 3 -- R/absolute_weighted_corr_fun.R | 2 +- R/check_covar_balance.R | 11 +++---- R/check_kolmogorov_smirnov.R | 4 +-- R/compile_pseudo_pop.R | 11 +++++-- R/compute_counter_weight.R | 14 ++++----- R/estimate_erf.R | 4 +-- R/estimate_gps.R | 4 +-- R/estimate_npmetric_erf.R | 31 +------------------ R/estimate_pmetric_erf.R | 25 +-------------- R/estimate_semipmetric_erf.R | 26 +--------------- R/generate_pseudo_pop.R | 16 ++++------ R/plot.R | 31 +++++++++++-------- R/trim_it.R | 2 +- man/check_covar_balance.Rd | 18 +++-------- man/check_kolmogorov_smirnov.Rd | 4 +-- man/compile_pseudo_pop.Rd | 10 +++--- man/compute_counter_weight.Rd | 13 ++++---- man/estimate_gps.Rd | 4 +-- man/estimate_npmetric_erf.Rd | 31 +------------------ man/estimate_pmetric_erf.Rd | 25 +-------------- man/estimate_semipmetric_erf.Rd | 26 +--------------- man/generate_pseudo_pop.Rd | 18 ++++------- .../testthat/test-check_kolmogorov_smirnov.R | 3 +- 24 files changed, 83 insertions(+), 253 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 6c17aadd..af758213 100755 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,9 +25,6 @@ export(compile_pseudo_pop) export(compute_counter_weight) export(estimate_erf) export(estimate_gps) -export(estimate_npmetric_erf) -export(estimate_pmetric_erf) -export(estimate_semipmetric_erf) export(generate_pseudo_pop) export(generate_syn_data) export(get_logger) diff --git a/R/absolute_weighted_corr_fun.R b/R/absolute_weighted_corr_fun.R index 7234b9f9..c26ce342 100755 --- a/R/absolute_weighted_corr_fun.R +++ b/R/absolute_weighted_corr_fun.R @@ -91,7 +91,7 @@ absolute_weighted_corr_fun <- function(w, mean_val <- mean(absolute_corr, na.rm = TRUE) # compute median value - median_val <- median(absolute_corr, na.rm = TRUE) + median_val <- stats::median(absolute_corr, na.rm = TRUE) # Maximal value max_val <- max(absolute_corr, na.rm = TRUE) diff --git a/R/check_covar_balance.R b/R/check_covar_balance.R index 3be670fc..9db1dc9f 100644 --- a/R/check_covar_balance.R +++ b/R/check_covar_balance.R @@ -10,14 +10,11 @@ #' @param counter_weight A weight vector in different situations. If the #' matching approach is selected, it is an integer data.table of counters. #' In the case of the weighting approach, it is weight data.table. -#' @param nthread The number of available threads. -#' @param ... Additional arguments passed to different models. +#' @param covar_bl_method Covariate balance method. Available options: +#' - 'absolute' +#' @param covar_bl_trs Covariate balance threshold. +#' @param covar_bl_trs_type Covariate balance type (mean, median, maximal). #' -#' @details -#' ## Additional parameters -#' - For ci_appr == matching: -#' - covar_bl_method -#' - covar_bl_trs #' #' @return #' output object: diff --git a/R/check_kolmogorov_smirnov.R b/R/check_kolmogorov_smirnov.R index 569cb910..d59a425a 100644 --- a/R/check_kolmogorov_smirnov.R +++ b/R/check_kolmogorov_smirnov.R @@ -11,7 +11,6 @@ #' @param counter_weight A weight vector in different situations. If the #' matching approach is selected, it is an integer data.table of counters. #' In the case of the weighting approach, it is weight data.table. -#' @param nthread The number of available threads. #' #' @return #' output object is list including: @@ -25,8 +24,7 @@ check_kolmogorov_smirnov <- function(w, c, ci_appr, - counter_weight = NULL, - nthread = 1) { + counter_weight = NULL) { logger::log_debug("Started checking Kolmogorov-Smirnov (KS) statistics ... ") s_ks_t <- proc.time() diff --git a/R/compile_pseudo_pop.R b/R/compile_pseudo_pop.R index 112c4f85..1e4acc41 100755 --- a/R/compile_pseudo_pop.R +++ b/R/compile_pseudo_pop.R @@ -15,14 +15,17 @@ #' @param ci_appr Causal inference approach. #' @param gps_density Model type which is used for estimating GPS value, #' including `normal` and `kernel`. -#' @param bin_seq Sequence of w (treatment) to generate pseudo population. If -#' NULL is passed the default value will be used, which is -#' `seq(min(w)+delta_n/2,max(w), by=delta_n)`. #' @param exposure_col_name Exposure data column name. #' @param nthread An integer value that represents the number of threads to be #' used by internal packages. #' @param ... Additional parameters. #' +#' @details +#' For matching approach, use an extra parameter, `bin_seq`, which is sequence +#' of w (treatment) to generate pseudo population. If `NULL` is passed the +#' default value will be used, which is +#' `seq(min(w)+delta_n/2,max(w), by=delta_n)`. +#' #' #' @export #' @@ -74,6 +77,8 @@ compile_pseudo_pop <- function(data_obj, nthread, ...) { + dist_measure <- delta_n <- bin_seq <- NULL + # Checking arguments # check_args_compile_pseudo_pop(ci_appr = ci_appr, ...) diff --git a/R/compute_counter_weight.R b/R/compute_counter_weight.R index 22dd1d1c..0fd96943 100644 --- a/R/compute_counter_weight.R +++ b/R/compute_counter_weight.R @@ -9,9 +9,6 @@ #' @param ci_appr The causal inference approach. Possible values are: #' - "matching": Matching by GPS #' - "weighting": Weighting by GPS -#' @param bin_seq Sequence of w (treatment) to generate pseudo population. If -#' NULL is passed the default value will be used, which is -#' `seq(min(w)+delta_n/2,max(w), by=delta_n)`. #' @param nthread An integer value that represents the number of threads to be #' used by internal packages. #' @param ... Additional arguments passed to different models. @@ -19,6 +16,9 @@ #' ## Additional parameters #' ### Causal Inference Approach (ci_appr) #' - if ci_appr = 'matching': +#' - *bin_seq*: A sequence of w (treatment) to generate pseudo population. +#' If `NULL` is passed the default value will be used, which is +#' `seq(min(w)+delta_n/2,max(w), by=delta_n)`. #' - *dist_measure*: Matching function. Available options: #' - l1: Manhattan distance matching #' - *delta_n*: caliper parameter. @@ -39,12 +39,12 @@ #' @examples #' \donttest{ #' m_d <- generate_syn_data(sample_size = 100) -#' gps_obj <- estimate_gps(data= m_d, -#' formula = w ~ cf1 + cf2 + cf3 + cf4 + cf5 + cf6, +#' gps_obj <- estimate_gps(.data = m_d, +#' .formula = w ~ cf1 + cf2 + cf3 + cf4 + cf5 + cf6, #' gps_density = "normal", #' sl_lib = c("SL.xgboost")) #' -#' cw_object <- compute_counter_weight(gps_obj = data_with_gps_1, +#' cw_object <- compute_counter_weight(gps_obj = gps_obj, #' ci_appr = "matching", #' bin_seq = NULL, #' nthread = 1, @@ -98,7 +98,7 @@ compute_counter_weight <- function(gps_obj, stop("delta_n input param is not provided for matching approach.") } if (is.null(scale)){ - stope("scale input param is not provided for matching approach.") + stop("scale input param is not provided for matching approach.") } if (is.null(dist_measure)){ stop("dist_measure input param is not provided for matching approach.") diff --git a/R/estimate_erf.R b/R/estimate_erf.R index c47f1b14..3818f966 100644 --- a/R/estimate_erf.R +++ b/R/estimate_erf.R @@ -154,7 +154,7 @@ estimate_erf <- function(.data, w_pred <- data.frame(w = w_vals) names(w_pred) <- predictor - y_pred <- predict(gam_model, w_pred) + y_pred <- stats::predict(gam_model, w_pred) names(y_pred) <- NULL result_data_original <- data.frame(x = x, @@ -192,7 +192,7 @@ estimate_erf <- function(.data, nthread = nthread, kernel_appr = kernel_appr) - formula_string <- deparse(as.formula(.formula)) + formula_string <- deparse(stats::as.formula(.formula)) parts <- strsplit(formula_string, "~")[[1]] predictor <- trimws(parts[2]) diff --git a/R/estimate_gps.R b/R/estimate_gps.R index 2d561e39..01e67dd6 100755 --- a/R/estimate_gps.R +++ b/R/estimate_gps.R @@ -33,8 +33,8 @@ #' @examples #' \donttest{ #' m_d <- generate_syn_data(sample_size = 100) -#' data_with_gps <- estimate_gps(data= m_d, -#' formula = w ~ cf1 + cf2 + cf3 + cf4 + cf5 + cf6, +#' data_with_gps <- estimate_gps(.data = m_d, +#' .formula = w ~ cf1 + cf2 + cf3 + cf4 + cf5 + cf6, #' gps_density = "normal", #' sl_lib = c("SL.xgboost") #' ) diff --git a/R/estimate_npmetric_erf.R b/R/estimate_npmetric_erf.R index b944edb7..43b1b056 100644 --- a/R/estimate_npmetric_erf.R +++ b/R/estimate_npmetric_erf.R @@ -31,37 +31,8 @@ #' - erf #' - fcall #' -#' @export +#' @keywords internal #' -#' @examples -#' \donttest{ -#' set.seed(697) -#' m_d <- generate_syn_data(sample_size = 200) -#' pseudo_pop <- generate_pseudo_pop(m_d[, c("id", "w")], -#' m_d[, c("id", "cf1","cf2","cf3", -#' "cf4","cf5","cf6")], -#' ci_appr = "matching", -#' pred_model = "sl", -#' sl_lib = c("m_xgboost"), -#' params = list(xgb_nrounds=c(10,20,30), -#' xgb_eta=c(0.1,0.2,0.3)), -#' nthread = 1, -#' covar_bl_method = "absolute", -#' covar_bl_trs = 0.1, -#' covar_bl_trs_type="mean", -#' max_attempt = 1, -#' dist_measure = "l1", -#' delta_n = 1, -#' scale = 0.5) -#' -#' data <- merge(m_d[, c("id", "Y")], pseudo_pop$pseudo_pop, by = "id") -#' erf_obj <- estimate_npmetric_erf(data$Y, -#' data$w, -#' data$counter_weight, -#' bw_seq=seq(0.2,2,0.2), -#' w_vals = seq(2,20,0.5), -#' nthread = 1) -#'} estimate_npmetric_erf<-function(m_Y, m_w, counter_weight, diff --git a/R/estimate_pmetric_erf.R b/R/estimate_pmetric_erf.R index a66893d3..e3d7b2fd 100644 --- a/R/estimate_pmetric_erf.R +++ b/R/estimate_pmetric_erf.R @@ -17,31 +17,8 @@ #' @return #' returns an object of class gnm #' -#' @export +#' @keywords internal #' -#' @examples -#'\donttest{ -#' m_d <- generate_syn_data(sample_size = 100) -#' pseudo_pop <- generate_pseudo_pop(m_d[, c("id", "w")], -#' m_d[, c("id", "cf1","cf2","cf3", -#' "cf4","cf5","cf6")], -#' ci_appr = "matching", -#' sl_lib = c("m_xgboost"), -#' params = list(xgb_nrounds=c(10,20,30), -#' xgb_eta=c(0.1,0.2,0.3)), -#' nthread = 1, -#' covar_bl_method = "absolute", -#' covar_bl_trs = 0.1, -#' covar_bl_trs_type= "mean", -#' max_attempt = 1, -#' dist_measure = "l1", -#' delta_n = 1, -#' scale = 0.5) -#' data <- merge(m_d[, c("id", "Y")], pseudo_pop$pseudo_pop, by = "id") -#' outcome_m <- estimate_pmetric_erf(formula = Y ~ w, -#' family = gaussian, -#' data = data) -#'} estimate_pmetric_erf <- function(formula, family, data, ...) { diff --git a/R/estimate_semipmetric_erf.R b/R/estimate_semipmetric_erf.R index 915eb9dd..098d64f5 100644 --- a/R/estimate_semipmetric_erf.R +++ b/R/estimate_semipmetric_erf.R @@ -17,32 +17,8 @@ #' @return #' returns an object of class gam #' -#' @export +#' @keywords internal #' -#' @examples -#' \donttest{ -#' m_d <- generate_syn_data(sample_size = 100) -#' pseudo_pop <- generate_pseudo_pop(m_d[, c("id", "w")], -#' m_d[, c("id", "cf1","cf2","cf3", -#' "cf4","cf5","cf6")], -#' ci_appr = "matching", -#' sl_lib = c("m_xgboost"), -#' params = list(xgb_nrounds=c(10,20,30), -#' xgb_eta=c(0.1,0.2,0.3)), -#' nthread = 1, -#' covar_bl_method = "absolute", -#' covar_bl_trs = 0.1, -#' covar_bl_trs_type = "mean", -#' max_attempt = 1, -#' dist_measure = "l1", -#' delta_n = 1, -#' scale = 0.5) -#' data <- merge(m_d[, c("id", "Y")], pseudo_pop$pseudo_pop, by = "id") -#' outcome_m <- estimate_semipmetric_erf (formula = Y ~ w, -#' family = gaussian, -#' data = data) -#' -#'} estimate_semipmetric_erf <- function(formula, family, data, ...) { diff --git a/R/generate_pseudo_pop.R b/R/generate_pseudo_pop.R index cc28b6f4..eef86855 100755 --- a/R/generate_pseudo_pop.R +++ b/R/generate_pseudo_pop.R @@ -10,13 +10,10 @@ #' #' @param .data A data.frame of observation data with `id` column. #' @param cw_obj An S3 object of counter_weight. -#' @param ci_appr The causal inference approach. Possible values are: -#' - "matching": Matching by GPS -#' - "weighting": Weighting by GPS -#' @param covariate_column_names A list of covariate columns. +#' @param covariate_col_names A list of covariate columns. +#' @param covar_bl_trs Covariate balance threshold +#' @param covar_bl_trs_type Type of the covariance balance threshold. #' @param covar_bl_method Covariate balance method. -#' @param covar_bl_trs: Covariate balance threshold -#' @param covar_bl_trs_type: Type of the covariance balance threshold. #' #' @return #' Returns a pseudo population (gpsm_pspop) object that is generated @@ -52,7 +49,7 @@ #' ...)} #' #' data_with_gps_1 <- estimate_gps( -#' .data = trimmed_data, +#' .data = m_d, #' .formula = w ~ I(cf1^2) + cf2 + I(cf3^2) + cf4 + cf5 + cf6, #' sl_lib = c("m_xgboost"), #' gps_density = "normal") @@ -66,7 +63,7 @@ #' scale = 0.5) #' #' pseudo_pop <- generate_pseudo_pop(.data = m_d, -#' cw_obj = cw_object_weighting, +#' cw_obj = cw_object_matching, #' covariate_col_names = c("cf1", "cf2", #' "cf3", "cf4", #' "cf5", "cf6"), @@ -138,8 +135,7 @@ generate_pseudo_pop <- function(.data, c = merged_data[, covariate_cols], counter_weight = merged_data[, c("counter_weight")], - ci_appr = cw_obj$params$ci_appr, - nthread = nthread) + ci_appr = cw_obj$params$ci_appr) # compute effective sample size diff --git a/R/plot.R b/R/plot.R index e3849d09..5ce906d9 100755 --- a/R/plot.R +++ b/R/plot.R @@ -338,6 +338,8 @@ plot.cgps_gps <- function(x, ...) { #' autoplot.cgps_cw <- function(object, ...){ + id <- counter_weight <- NULL + dataset <- object$.data # Default values @@ -485,12 +487,13 @@ plot.cgps_cw <- function(x, ...) { #' autoplot.cgps_erf <- function(object, ...){ - df1 <- object$.data_original - df2 <- object$.data_prediction - # Default values + x <- y_original <- normalized_weight <- w_vals <- y_pred <- NULL + df1 <- object$.data_original + df2 <- object$.data_prediction + ## collect additional arguments dot_args <- list(...) arg_names <- names(dot_args) @@ -499,16 +502,18 @@ autoplot.cgps_erf <- function(object, ...){ assign(i, unlist(dot_args[i], use.names = FALSE)) } - g <- ggplot() + - ggplot2::geom_point(data = df1, aes(x, y_original, size=normalized_weight), - color="blue", alpha=0.1) + - ggplot2::geom_line(data = df2, aes(w_vals, y_pred), color = "orange") + - ggplot2::geom_point(data = df2, aes(w_vals, y_pred), color = "orange") + - ggplot2::labs(x = "Exposure", - y = "Outcome") + - ggplot2::ggtitle(paste0("Exposure Response Curve for ", - object$params$model_type, " model")) + - ggplot2::theme_bw() + g <- ggplot2::ggplot() + + ggplot2::geom_point(data = df1, ggplot2::aes(x, + y_original, + size=normalized_weight), + color="blue", alpha=0.1) + + ggplot2::geom_line(data = df2, ggplot2::aes(w_vals, y_pred), color = "orange") + + ggplot2::geom_point(data = df2, ggplot2::aes(w_vals, y_pred), color = "orange") + + ggplot2::labs(x = "Exposure", + y = "Outcome") + + ggplot2::ggtitle(paste0("Exposure Response Curve for ", + object$params$model_type, " model")) + + ggplot2::theme_bw() return(g) } diff --git a/R/trim_it.R b/R/trim_it.R index acef3144..e634aa5e 100644 --- a/R/trim_it.R +++ b/R/trim_it.R @@ -34,7 +34,7 @@ trim_it <- function(data_obj, trim_quantiles, variable){ type_flag <- NULL - if (class(data_obj) == "data.frame"){ + if (is.data.frame(data_obj)){ data <- data_obj type_flag <- "data.frame" } else if (is.object(data_obj) && !isS4(data_obj)){ diff --git a/man/check_covar_balance.Rd b/man/check_covar_balance.Rd index 70ef4fcb..874760ef 100755 --- a/man/check_covar_balance.Rd +++ b/man/check_covar_balance.Rd @@ -25,9 +25,12 @@ check_covar_balance( matching approach is selected, it is an integer data.table of counters. In the case of the weighting approach, it is weight data.table.} -\item{nthread}{The number of available threads.} +\item{covar_bl_method}{Covariate balance method. Available options: +- 'absolute'} -\item{...}{Additional arguments passed to different models.} +\item{covar_bl_trs}{Covariate balance threshold.} + +\item{covar_bl_trs_type}{Covariate balance type (mean, median, maximal).} } \value{ output object: @@ -43,17 +46,6 @@ output object: \description{ Checks the covariate balance of original population or pseudo population. } -\details{ -\subsection{Additional parameters}{ -\itemize{ -\item For ci_appr == matching: -\itemize{ -\item covar_bl_method -\item covar_bl_trs -} -} -} -} \examples{ \donttest{ set.seed(422) diff --git a/man/check_kolmogorov_smirnov.Rd b/man/check_kolmogorov_smirnov.Rd index 99b04667..27b10a16 100644 --- a/man/check_kolmogorov_smirnov.Rd +++ b/man/check_kolmogorov_smirnov.Rd @@ -4,7 +4,7 @@ \alias{check_kolmogorov_smirnov} \title{Check Kolmogorov-Smirnov (KS) statistics} \usage{ -check_kolmogorov_smirnov(w, c, ci_appr, counter_weight = NULL, nthread = 1) +check_kolmogorov_smirnov(w, c, ci_appr, counter_weight = NULL) } \arguments{ \item{w}{A vector of observed continuous exposure variable.} @@ -16,8 +16,6 @@ check_kolmogorov_smirnov(w, c, ci_appr, counter_weight = NULL, nthread = 1) \item{counter_weight}{A weight vector in different situations. If the matching approach is selected, it is an integer data.table of counters. In the case of the weighting approach, it is weight data.table.} - -\item{nthread}{The number of available threads.} } \value{ output object is list including: diff --git a/man/compile_pseudo_pop.Rd b/man/compile_pseudo_pop.Rd index 616cd3e8..a960ce2b 100755 --- a/man/compile_pseudo_pop.Rd +++ b/man/compile_pseudo_pop.Rd @@ -35,10 +35,6 @@ including \code{normal} and \code{kernel}.} used by internal packages.} \item{...}{Additional parameters.} - -\item{bin_seq}{Sequence of w (treatment) to generate pseudo population. If -NULL is passed the default value will be used, which is -\code{seq(min(w)+delta_n/2,max(w), by=delta_n)}.} } \value{ \code{compile_pseudo_pop} returns the pseudo population data that is compiled based @@ -48,6 +44,12 @@ on the selected causal inference approach. Compiles pseudo population based on the original population and estimated GPS value. } +\details{ +For matching approach, use an extra parameter, \code{bin_seq}, which is sequence +of w (treatment) to generate pseudo population. If \code{NULL} is passed the +default value will be used, which is +\code{seq(min(w)+delta_n/2,max(w), by=delta_n)}. +} \examples{ \donttest{ set.seed(112) diff --git a/man/compute_counter_weight.Rd b/man/compute_counter_weight.Rd index e2cc77d0..9b76923c 100644 --- a/man/compute_counter_weight.Rd +++ b/man/compute_counter_weight.Rd @@ -20,10 +20,6 @@ If it is provided, the number of iteration will forced to 1 (Default: NULL).} used by internal packages.} \item{...}{Additional arguments passed to different models.} - -\item{bin_seq}{Sequence of w (treatment) to generate pseudo population. If -NULL is passed the default value will be used, which is -\code{seq(min(w)+delta_n/2,max(w), by=delta_n)}.} } \value{ Returns a counter_weight (cgps_cw) object that includes \code{.data} and \code{params} @@ -45,6 +41,9 @@ Computes counter (for matching approach) or weight (for weighting) approach. \itemize{ \item if ci_appr = 'matching': \itemize{ +\item \emph{bin_seq}: A sequence of w (treatment) to generate pseudo population. +If \code{NULL} is passed the default value will be used, which is +\code{seq(min(w)+delta_n/2,max(w), by=delta_n)}. \item \emph{dist_measure}: Matching function. Available options: \itemize{ \item l1: Manhattan distance matching @@ -61,12 +60,12 @@ is attributed to the distance measures of the exposure versus the GPS. \examples{ \donttest{ m_d <- generate_syn_data(sample_size = 100) -gps_obj <- estimate_gps(data= m_d, - formula = w ~ cf1 + cf2 + cf3 + cf4 + cf5 + cf6, +gps_obj <- estimate_gps(.data = m_d, + .formula = w ~ cf1 + cf2 + cf3 + cf4 + cf5 + cf6, gps_density = "normal", sl_lib = c("SL.xgboost")) -cw_object <- compute_counter_weight(gps_obj = data_with_gps_1, +cw_object <- compute_counter_weight(gps_obj = gps_obj, ci_appr = "matching", bin_seq = NULL, nthread = 1, diff --git a/man/estimate_gps.Rd b/man/estimate_gps.Rd index a7cf979c..cbfe0027 100755 --- a/man/estimate_gps.Rd +++ b/man/estimate_gps.Rd @@ -50,8 +50,8 @@ approaches. \examples{ \donttest{ m_d <- generate_syn_data(sample_size = 100) -data_with_gps <- estimate_gps(data= m_d, - formula = w ~ cf1 + cf2 + cf3 + cf4 + cf5 + cf6, +data_with_gps <- estimate_gps(.data = m_d, + .formula = w ~ cf1 + cf2 + cf3 + cf4 + cf5 + cf6, gps_density = "normal", sl_lib = c("SL.xgboost") ) diff --git a/man/estimate_npmetric_erf.Rd b/man/estimate_npmetric_erf.Rd index da5cbd8d..7de1da7c 100644 --- a/man/estimate_npmetric_erf.Rd +++ b/man/estimate_npmetric_erf.Rd @@ -52,33 +52,4 @@ data set using non-parametric models. \details{ Estimate Functions Using Local Polynomial kernel regression. } -\examples{ -\donttest{ -set.seed(697) -m_d <- generate_syn_data(sample_size = 200) -pseudo_pop <- generate_pseudo_pop(m_d[, c("id", "w")], - m_d[, c("id", "cf1","cf2","cf3", - "cf4","cf5","cf6")], - ci_appr = "matching", - pred_model = "sl", - sl_lib = c("m_xgboost"), - params = list(xgb_nrounds=c(10,20,30), - xgb_eta=c(0.1,0.2,0.3)), - nthread = 1, - covar_bl_method = "absolute", - covar_bl_trs = 0.1, - covar_bl_trs_type="mean", - max_attempt = 1, - dist_measure = "l1", - delta_n = 1, - scale = 0.5) - -data <- merge(m_d[, c("id", "Y")], pseudo_pop$pseudo_pop, by = "id") -erf_obj <- estimate_npmetric_erf(data$Y, - data$w, - data$counter_weight, - bw_seq=seq(0.2,2,0.2), - w_vals = seq(2,20,0.5), - nthread = 1) -} -} +\keyword{internal} diff --git a/man/estimate_pmetric_erf.Rd b/man/estimate_pmetric_erf.Rd index 3a983db2..c79157d5 100644 --- a/man/estimate_pmetric_erf.Rd +++ b/man/estimate_pmetric_erf.Rd @@ -26,27 +26,4 @@ parametric models \details{ This method uses generalized nonlinear model (gnm) from gnm package. } -\examples{ -\donttest{ -m_d <- generate_syn_data(sample_size = 100) -pseudo_pop <- generate_pseudo_pop(m_d[, c("id", "w")], - m_d[, c("id", "cf1","cf2","cf3", - "cf4","cf5","cf6")], - ci_appr = "matching", - sl_lib = c("m_xgboost"), - params = list(xgb_nrounds=c(10,20,30), - xgb_eta=c(0.1,0.2,0.3)), - nthread = 1, - covar_bl_method = "absolute", - covar_bl_trs = 0.1, - covar_bl_trs_type= "mean", - max_attempt = 1, - dist_measure = "l1", - delta_n = 1, - scale = 0.5) -data <- merge(m_d[, c("id", "Y")], pseudo_pop$pseudo_pop, by = "id") -outcome_m <- estimate_pmetric_erf(formula = Y ~ w, - family = gaussian, - data = data) -} -} +\keyword{internal} diff --git a/man/estimate_semipmetric_erf.Rd b/man/estimate_semipmetric_erf.Rd index e304703a..6450c9e8 100644 --- a/man/estimate_semipmetric_erf.Rd +++ b/man/estimate_semipmetric_erf.Rd @@ -26,28 +26,4 @@ additive model with splines. \details{ This approach uses Generalized Additive Model (gam) using mgcv package. } -\examples{ -\donttest{ -m_d <- generate_syn_data(sample_size = 100) -pseudo_pop <- generate_pseudo_pop(m_d[, c("id", "w")], - m_d[, c("id", "cf1","cf2","cf3", - "cf4","cf5","cf6")], - ci_appr = "matching", - sl_lib = c("m_xgboost"), - params = list(xgb_nrounds=c(10,20,30), - xgb_eta=c(0.1,0.2,0.3)), - nthread = 1, - covar_bl_method = "absolute", - covar_bl_trs = 0.1, - covar_bl_trs_type = "mean", - max_attempt = 1, - dist_measure = "l1", - delta_n = 1, - scale = 0.5) -data <- merge(m_d[, c("id", "Y")], pseudo_pop$pseudo_pop, by = "id") -outcome_m <- estimate_semipmetric_erf (formula = Y ~ w, - family = gaussian, - data = data) - -} -} +\keyword{internal} diff --git a/man/generate_pseudo_pop.Rd b/man/generate_pseudo_pop.Rd index 2b7a6ab6..c8d95250 100644 --- a/man/generate_pseudo_pop.Rd +++ b/man/generate_pseudo_pop.Rd @@ -18,19 +18,13 @@ generate_pseudo_pop( \item{cw_obj}{An S3 object of counter_weight.} -\item{covar_bl_method}{Covariate balance method.} - -\item{ci_appr}{The causal inference approach. Possible values are: -\itemize{ -\item "matching": Matching by GPS -\item "weighting": Weighting by GPS -}} +\item{covariate_col_names}{A list of covariate columns.} -\item{covariate_column_names}{A list of covariate columns.} +\item{covar_bl_trs}{Covariate balance threshold} -\item{covar_bl_trs:}{Covariate balance threshold} +\item{covar_bl_trs_type}{Type of the covariance balance threshold.} -\item{covar_bl_trs_type:}{Type of the covariance balance threshold.} +\item{covar_bl_method}{Covariate balance method.} } \value{ Returns a pseudo population (gpsm_pspop) object that is generated @@ -76,7 +70,7 @@ m_xgboost <- function(nthread = 4, ...)} data_with_gps_1 <- estimate_gps( - .data = trimmed_data, + .data = m_d, .formula = w ~ I(cf1^2) + cf2 + I(cf3^2) + cf4 + cf5 + cf6, sl_lib = c("m_xgboost"), gps_density = "normal") @@ -90,7 +84,7 @@ cw_object_matching <- compute_counter_weight(gps_obj = data_with_gps_1, scale = 0.5) pseudo_pop <- generate_pseudo_pop(.data = m_d, - cw_obj = cw_object_weighting, + cw_obj = cw_object_matching, covariate_col_names = c("cf1", "cf2", "cf3", "cf4", "cf5", "cf6"), diff --git a/tests/testthat/test-check_kolmogorov_smirnov.R b/tests/testthat/test-check_kolmogorov_smirnov.R index 4e721e90..02740bab 100644 --- a/tests/testthat/test-check_kolmogorov_smirnov.R +++ b/tests/testthat/test-check_kolmogorov_smirnov.R @@ -48,8 +48,7 @@ test_that("check_kolmogorov_smirnov works as expected.", { output <- CausalGPS:::check_kolmogorov_smirnov(w = ps_pop1$.data[, c("w")], c = ps_pop1$.data[, ps_pop1$params$covariate_col_names], counter = ps_pop1$.data[, c("counter_weight")], - ci_appr="matching", - nthread=1) + ci_appr="matching") expect_equal(length(output), 2L) expect_equal(length(output$ks_stat), 7L)