Merge pull request #114 from RSGInc/106-remove-missing-weights

106 remove missing weights

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: travelSurveyTools
 Title: travelSurveyTools
-Version: 2.2.0
+Version: 2.3.0
 Authors@R: c(
     person("RSG", "Inc.", , "[email protected]", role = c("aut", "cre")),
     person("Ashley", "Asmus", , "[email protected]", role = "aut"),

NEWS.md

@@ -1,7 +1,12 @@
+# travelSurveyTools 2.3.0
+
+- Set missing weights to 0
+
 # travelSurveyTools 2.2.0
 
 - Add example using year to `getting_started` vignette
 
+
 # travelSurveyTools 2.1.0
 
 - Fix bug in checkbox variable proportions (`hts_summary_cat`)

R/hts_prep_byvar.R

@@ -47,6 +47,8 @@ hts_prep_byvar = function(summarize_by = NULL,
 
     tbl_idx = which(names(hts_data) == byvar_loc)
 
+    wtname = byvar_wts[tbl_idx]
+
     byvar_dt_v = data.table::copy(hts_data[[byvar_loc]])
 
     # Check that specified id column exists in var_dt
@@ -59,6 +61,24 @@ hts_prep_byvar = function(summarize_by = NULL,
     # Is this a numeric variable?
     byvar_is_numeric = variables_dt[shared_name == summarize_by[[b]], data_type][[1]] == "numeric"
 
+    #check for missing weight variables
+    missing_weight_count = byvar_dt_v[is.na(get(wtname)), .N]
+
+    if (missing_weight_count > 0){
+
+      message(missing_weight_count, ' missing observation(s) of ', wtname, 
+              ' in ', byvar_loc, ' setting equal to 0')
+
+      setnames(byvar_dt_v, wtname, 'old_weight')
+
+      byvar_dt_v[, old_weight := ifelse(is.na(old_weight),
+                                    0,
+                                    old_weight)]
+
+      setnames(byvar_dt_v, 'old_weight', wtname)
+
+    }
+
     if (byvar_is_shared) {
 
       byvar_dt_v =
@@ -113,4 +133,4 @@ hts_prep_byvar = function(summarize_by = NULL,
 
 
 ## quiets concerns of R CMD check
-utils::globalVariables(c("variables_list", "is_checkbox", "data_type"))
+utils::globalVariables(c("variables_list", "is_checkbox", "data_type", "old_weight"))

R/hts_prep_data.R

@@ -130,19 +130,28 @@ hts_prep_data = function(summarize_var = NULL,
 
   tbl_idx = which(names(data) == var_location)
 
+  wtname = wt_cols[tbl_idx]
+
   # Select table where this variable lives:
   var_dt = data[[var_location]]
 
-  # browser()
-  # #check for missing weight variables
-  # missing_weight_count = var_dt[is.na(ids[tbl_idx]), .N]
-  # 
-  # if (missing_weight_count > 0){
-  # 
-  #   message(missing_weight_count, ' missing weight(s) of ', ids[tbl_idx],
-  #           ' in ', var_location, ' setting equal to 0')
-  # 
-  # }
+  #check for missing weight variables
+  missing_weight_count = var_dt[is.na(get(wtname)), .N]
+
+  if (missing_weight_count > 0){
+
+    message(missing_weight_count, ' missing observation(s) of ', wtname, 
+            ' in ', var_location, ' setting equal to 0')
+
+    setnames(var_dt, wtname, 'old_weight')
+
+    var_dt[, old_weight := ifelse(is.na(old_weight),
+                                   0,
+                                   old_weight)]
+
+    setnames(var_dt, 'old_weight', wtname)
+
+  }
 
   # Check that specified id column exists in var_dt
   stopifnot("table id not in var_dt, make id_cols ordered list of ids in each table of data" =
@@ -175,7 +184,6 @@ hts_prep_data = function(summarize_var = NULL,
   sum_vars_id_cols = intersect(id_cols, names(var_dt))
 
   # Subset table to these column(s):
-  wtname = wt_cols[tbl_idx]
 
   if (weighted){
 
@@ -389,4 +397,4 @@ hts_prep_data = function(summarize_var = NULL,
 
 
 ## quiets concerns of R CMD check
-utils::globalVariables(c("hts_data", "is_checkbox", "data_type"))
+utils::globalVariables(c("hts_data", "is_checkbox", "data_type", "old_weight"))