fix examples

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)

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)

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:

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()

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, ...)
 

R/compute_counter_weight.R

@@ -9,16 +9,16 @@
 #' @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.
 #' @details
 #' ## 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.")

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])
 

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")
 #'                              )

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,

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, ...) {
 
 

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, ...) {
 
 

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

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)
 }

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)){