Merge pull request #11 from Displayr/DS-3136

DS-3136 Replace sum with verbs::Sum

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: flipData
 Type: Package
 Title: Functions for extracting and describing data
-Version: 1.2.16
+Version: 1.2.17
 Author: Displayr <opensource@displayr.com>
 Maintainer: Displayr <opensource@displayr.com>
 Description: Functions for extracting data from formulas and
@@ -21,7 +21,8 @@ Imports: CVXR (>= 1.0.0),
  lubridate,
  stats,
  stringr,
- survey
+ survey,
+ verbs
 RoxygenNote: 7.1.1
 Encoding: UTF-8
 Suggests: foreign,
@@ -32,4 +33,5 @@ Remotes: Displayr/flipExampleData,
  Displayr/flipImputation,
  Displayr/flipTime,
  Displayr/flipTransformations,
- Displayr/flipU
+ Displayr/flipU,
+ Displayr/verbs

NAMESPACE

@@ -77,3 +77,6 @@ importFrom(stringr,str_trim)
 importFrom(survey,calibrate)
 importFrom(survey,rake)
 importFrom(survey,svydesign)
+importFrom(verbs,Sum)
+importFrom(verbs,SumColumns)
+importFrom(verbs,SumRows)

R/autocoerceclass.R

@@ -12,6 +12,7 @@
 #' @importFrom lubridate is.Date is.POSIXt is.timepoint
 #' @importFrom flipTime AsDateTime
 #' @importFrom stats as.formula
+#' @importFrom verbs Sum
 #' @export
 
 AutoCoerceClass <- function(x, stringsAsFactors = TRUE, max.value.labels = 12)
@@ -41,7 +42,7 @@ AutoCoerceClass <- function(x, stringsAsFactors = TRUE, max.value.labels = 12)
     out <- rep(NA, n)
 
     # Numeric
-    if (suppressWarnings(sum(is.na(num <- as.numeric(x.not.missing))) == 0))
+    if (suppressWarnings(Sum(is.na(num <- as.numeric(x.not.missing)), remove.missing = FALSE) == 0))
     {
         out[!missing] <- num
         return(out)
@@ -55,7 +56,7 @@ AutoCoerceClass <- function(x, stringsAsFactors = TRUE, max.value.labels = 12)
         class(out) <- class(dts)
         return(out)
     }
-    if (suppressWarnings(sum(is.na((dat <- AsDateTime(x, on.parse.failure = "warn"))[!missing])) == 0))
+    if (suppressWarnings(Sum(is.na((dat <- AsDateTime(x, on.parse.failure = "warn"))[!missing]), remove.missing = FALSE) == 0))
         return(dat)
 
     # Text versus factors

R/calibrate.R

@@ -104,11 +104,12 @@ Calibrate <- function(categorical.variables = NULL,
 }
 
 # Converts lists to data fames, checking the data for errors along the way.
+#' @importFrom verbs SumColumns
 convertToDataFrame <- function(x)
 {
     x = as.data.frame(x, stringsAsFactors = TRUE)
     # Check that data frame is complete
-    var.missing = colSums(is.na(x)) > 0
+    var.missing = SumColumns(is.na(x), remove.missing = FALSE) > 0
     if (any(var.missing))
     {
         var.missing = paste(names(var.missing)[var.missing], collapse = ", ")
@@ -119,6 +120,7 @@ convertToDataFrame <- function(x)
 
 ## Checks and tidies categorical targets
 #' @importFrom stringr str_trim
+#' @importFrom verbs Sum
 categoricalTargets <- function(adjustment.variables, categorical.targets, subset)
 {
     targets = list()
@@ -155,7 +157,7 @@ categoricalTargets <- function(adjustment.variables, categorical.targets, subset
                 stop("Target category that does not appear in variable ", varname, ": ",
                      excess.cats, (if(is.null(subset)) "" else " (after applying filter/subset)"))
         }
-        if ((sm = sum(targets[[i]])) != 1)
+        if ((sm = Sum(targets[[i]], remove.missing = FALSE)) != 1)
         {
             if (round(sm, 6) == 1)# Forcing to add up to 1 if difference likely due to rounding errors.
                 targets[[i]] = prop.table(targets[[i]])
@@ -252,6 +254,7 @@ createMargins <- function(targets, adjustment.variables, n.categorical, raking,
 #' @importFrom survey calibrate rake
 #' @importFrom stats model.matrix weights terms.formula
 #' @importFrom CVXR Variable Minimize Problem entr solve
+#' @importFrom verbs Sum
 computeCalibrate <- function(adjustment.variables, margins, input.weight, raking, package)
 {
     if (package == "survey" | raking)

R/estimationdata.R

@@ -55,6 +55,7 @@
 #'     imputation performed (if requested) \item \code{description} -
 #'     character; description of the data; see
 #'     \code{\link[flipFormat]{SampleDescription}} }
+#' @importFrom verbs Sum
 #' @export
 EstimationData <- function(formula = NULL,
                            data = NULL,
@@ -149,7 +150,7 @@ EstimationData <- function(formula = NULL,
             data.for.estimation <- RemoveMissingLevelsFromFactors(data.for.estimation)
             levels.post <- paste0(rep(labels, vapply(data.for.estimation[data.cols], nlevels, 0L)), ": ",
                                  unlist(lapply(data.for.estimation, levels)))
-            
+
             levels.diff <- setdiff(levels.pre, levels.post)
             if (length(levels.diff) > 0)
             {
@@ -170,7 +171,7 @@ EstimationData <- function(formula = NULL,
         weights <- weights[estimation.sample]
 
     # Reporting.
-    n.estimation <- sum(estimation.sample)
+    n.estimation <- Sum(estimation.sample, remove.missing = FALSE)
     if (error.if.insufficient.obs && n.estimation < length(variable.names))
         stop(gettextf("There are fewer observations (%d)%s(%d)", n.estimation,
                       " than there are variables ", length(variable.names)))

R/missingdata.R

@@ -41,10 +41,11 @@ ExcludeCasesWithAnyMissingData <- function(data)
 #' @examples
 #' my.df <- data.frame("A" = c(1, 2, 3, 4, NA), "B" = c(NA, 1, 2, 3, NA), "C" = c(NA, NA, 1, 2, NA))
 #' ExcludeCasesWithCompletelyMissingData(my.df)
+#' @importFrom verbs SumRows
 #' @export
 ExcludeCasesWithCompletelyMissingData <- function(data)
 {
-    result <- data[rowSums(is.na(data)) < ncol(data), ]
+    result <- data[SumRows(is.na(data), remove.missing = FALSE) < ncol(data), ]
     if (nrow(result) == 0)
     {
         NoData()
@@ -111,6 +112,7 @@ MissingValuesByVariable <- function(data)
 #' Takes a QSubset variable and turns it into a logical vector with no missing values
 #' @param subset A QSubset variable from Displayr or Q.
 #' @param n.total The total number of observations.
+#' @importFrom verbs Sum
 #' @export
 CleanSubset <- function(subset, n.total)
 {
@@ -139,7 +141,7 @@ CleanSubset <- function(subset, n.total)
     }
     if (!is.null(new.subset))
         subset <- CopyAttributes(new.subset, subset)
-    n.subset <- sum(subset)
+    n.subset <- Sum(subset, remove.missing = FALSE)
     attr(subset, "n.subset") = n.subset
     subset
 }

R/splitformquestions.R

@@ -86,6 +86,7 @@ SplitFormQuestions <- function(form.data, show.labels = TRUE,
 #'     Grid questions.
 #' @param variable.labels.source The source of the variable labels, to
 #'     be used to show the error message.
+#' @importFrom verbs Sum
 #' @export
 MatchVariableLabelsToQuestion <- function(labels.from.mixed.input,
                                           variable.labels,
@@ -106,7 +107,7 @@ MatchVariableLabelsToQuestion <- function(labels.from.mixed.input,
         ind <- sapply(grid.labels.split, length) == 2
         grid.labels <- grid.labels[ind]
         grid.labels.split <- grid.labels.split[ind]
-        n.grid.labels <- sum(ind)
+        n.grid.labels <- Sum(ind, remove.missing = FALSE)
         for (lbl in not.found)
         {
             min.nchar.diff <- Inf

R/weights.R

@@ -14,12 +14,13 @@ WeightedSurveyDesign <- function(data, weights)
 #' @param weights A vector of weights.
 #' @references Kish, Leslie (1965). Survey Sampling. New York: Wiley.
 #' @return numeric
+#' @importFrom verbs Sum
 #' @export
 EffectiveSampleSize <- function(weights)
 {
     if (any(is.na(weights) | weights < 0 | !is.finite(weights)))
         stop("'weights' must be positive numbers.")
-    sum(weights)^2 / sum(weights^2)
+    Sum(weights, remove.missing = FALSE)^2 / Sum(weights^2, remove.missing = FALSE)
 }
 
 
@@ -28,10 +29,11 @@ EffectiveSampleSize <- function(weights)
 #' @param weights A vector of weights.
 #' @param strata Strata, to perform the weight-calibration within.
 #' @return vector
+#' @importFrom verbs Sum
 #' @export
 CalibrateWeight <- function(weights, strata = NULL)
 {
-    .calibrate <- function(weights) weights / sum(weights) * EffectiveSampleSize(weights)
+    .calibrate <- function(weights) weights / Sum(weights, remove.missing = FALSE) * EffectiveSampleSize(weights)
     if (is.null(strata))
         return(.calibrate(weights))
     strata <- factor(strata)