check_balance method added, further work on estimates in groups - non…

…probsvymean, nonprobsvytotal - DONE when svydesign object is provided, potential implementation for pop totals - TODO. nonprobvyby - DONE for MI, IPW without variance implementation, TODO for DR

NAMESPACE

@@ -2,6 +2,7 @@
 
 S3method(AIC,nonprobsvy)
 S3method(BIC,nonprobsvy)
+S3method(check_balance,nonprobsvy)
 S3method(confint,nonprobsvy)
 S3method(cooks.distance,nonprobsvy)
 S3method(deviance,nonprobsvy)
@@ -10,6 +11,7 @@ S3method(logLik,nonprobsvy)
 S3method(nobs,nonprobsvy)
 S3method(pop.size,nonprobsvy)
 S3method(print,nonprobsvy)
+S3method(print,nonprobsvy_balance)
 S3method(print,summary_nonprobsvy)
 S3method(residuals,nonprobsvy)
 S3method(summary,nonprobsvy)
@@ -34,13 +36,16 @@ importFrom(Rcpp,sourceCpp)
 importFrom(doParallel,registerDoParallel)
 importFrom(foreach,"%dopar%")
 importFrom(foreach,foreach)
+importFrom(formula.tools,lhs.vars)
+importFrom(formula.tools,rhs.vars)
 importFrom(maxLik,maxLik)
 importFrom(ncvreg,cv.ncvreg)
 importFrom(nleqslv,nleqslv)
 importFrom(parallel,makeCluster)
 importFrom(parallel,stopCluster)
 importFrom(stats,AIC)
 importFrom(stats,BIC)
+importFrom(stats,aggregate)
 importFrom(stats,as.formula)
 importFrom(stats,binomial)
 importFrom(stats,coef)

R/nonprobDR.R

@@ -83,8 +83,6 @@ nonprobDR <- function(selection,
       data = data,
       svydesign = svydesign
     )
-    prob_totals <- svytotal(selection, svydesign)
-    prob_pop_totals <- c(sum(weights(svydesign)), prob_totals)
     # if (all(svydesign$prob) == 1) { # TODO
     #  if (!is.null(pop_size)) {
     #      ps_rand <- rep(sum(svydesign$prob)/pop_size, length(svydesign$prob))
@@ -577,7 +575,6 @@ nonprobDR <- function(selection,
         }
         SelectionModel$total_names <- names(SelectionModel$pop_totals)
       }
-      prob_pop_totals <- SelectionModel$pop_totals
 
       if (is.null(start_selection)) {
         if (control_selection$start_type == "glm") {
@@ -848,8 +845,6 @@ nonprobDR <- function(selection,
   if (is.null(pop_size)) pop_size <- N_nons
   names(pop_size) <- "pop_size"
   names(ys) <- all.vars(outcome_init[[2]])
-  est_totals <- colSums(SelectionModel$X_nons * as.vector(weights_nons))
-  names(prob_pop_totals) <- colnames(SelectionModel$X_nons)
 
   boot_sample <- if (control_inference$var_method == "bootstrap" & control_inference$keep_boot) {
     stat
@@ -870,7 +865,6 @@ nonprobDR <- function(selection,
     aic = selection_model$aic,
     weights = as.vector(weights_nons),
     prior.weights = weights,
-    est_totals = est_totals,
     formula = selection,
     df_residual = selection_model$df_residual,
     log_likelihood = selection_model$log_likelihood,
@@ -909,7 +903,6 @@ nonprobDR <- function(selection,
       nonprob_size = n_nons,
       prob_size = n_rand,
       pop_size = pop_size,
-      pop_totals = prob_pop_totals,
       outcome = OutcomeList,
       selection = SelectionList,
       boot_sample = boot_sample,

R/nonprobIPW.R

@@ -68,9 +68,6 @@ nonprobIPW <- function(selection,
       data = data,
       svydesign = svydesign
     )
-    prob_totals <- svytotal(selection, svydesign)
-    prob_pop_totals <- c(sum(weights(svydesign)), prob_totals)
-    # y_nons <- model$y_nons
 
     X_nons <- model$X_nons
     X_rand <- model$X_rand
@@ -279,7 +276,6 @@ nonprobIPW <- function(selection,
       pop_totals <- model$pop_totals[idx]
     }
 
-    prob_pop_totals <- pop_totals
     if (is.null(start_selection)) {
       if (control_selection$start_type == "glm") {
         start_selection <- start_fit(
@@ -540,8 +536,7 @@ nonprobIPW <- function(selection,
   if (is.null(pop_size)) pop_size <- N # estimated pop_size
   names(pop_size) <- "pop_size"
   names(ys) <- all.vars(outcome_init[[2]])
-  est_totals <- colSums(X_nons * as.vector(weights_nons))
-  names(prob_pop_totals) <- colnames(X_nons)
+
 
   boot_sample <- if (control_inference$var_method == "bootstrap" & control_inference$keep_boot) {
     boot_obj$stat
@@ -562,7 +557,6 @@ nonprobIPW <- function(selection,
     aic = selection_model$aic,
     weights = as.vector(weights_nons),
     prior.weights = weights,
-    est_totals = est_totals,
     pop_totals = pop_totals,
     formula = selection,
     df_residual = selection_model$df_residual,
@@ -601,7 +595,6 @@ nonprobIPW <- function(selection,
       nonprob_size = n_nons,
       prob_size = n_rand,
       pop_size = pop_size,
-      pop_totals = prob_pop_totals,
       outcome = NULL,
       selection = SelectionList,
       boot_sample = boot_sample,

R/prints.R

@@ -115,11 +115,6 @@ print.summary_nonprobsvy <- function(x,
 
     cat("-------------------------\n\n")
 
-    cat("Covariate balance:\n")
-    print(x$est_totals - x$totals[which(!is.na(x$est_totals))])
-
-    cat("-------------------------\n\n")
-
     cat("Residuals:\n")
     print(summary(x$residuals$selection))
 
@@ -139,3 +134,18 @@ print.summary_nonprobsvy <- function(x,
 
   invisible(x)
 }
+#' @export
+print.nonprobsvy_balance <- function(x, ...) {
+  cat("Balance check results:\n\n")
+
+  # Create a data frame for nice printing
+  results <- data.frame(
+    Variable = names(x$balance),
+    NonProb_Total = x$nonprob_totals,
+    Prob_Total = x$prob_totals[names(x$balance)],
+    Difference = x$balance,
+    row.names = NULL
+  )
+
+  print(results)
+}