code style

Author: hfrick

R/convert_data.R

@@ -38,35 +38,38 @@
 #' @importFrom stats .checkMFClasses .getXlevels delete.response
 #' @importFrom stats model.offset model.weights na.omit na.pass
 .convert_form_to_xy_fit <- function(formula,
-                                   data,
-                                   ...,
-                                   na.action = na.omit,
-                                   indicators = "traditional",
-                                   composition = "data.frame",
-                                   remove_intercept = TRUE) {
-
-  if (!(composition %in% c("data.frame", "matrix")))
+                                    data,
+                                    ...,
+                                    na.action = na.omit,
+                                    indicators = "traditional",
+                                    composition = "data.frame",
+                                    remove_intercept = TRUE) {
+  if (!(composition %in% c("data.frame", "matrix"))) {
     rlang::abort("`composition` should be either 'data.frame' or 'matrix'.")
+  }
 
   ## Assemble model.frame call from call arguments
   mf_call <- quote(model.frame(formula, data))
   mf_call$na.action <- match.call()$na.action # TODO this should work better
   dots <- quos(...)
   check_form_dots(dots)
-  for(i in seq_along(dots))
-    mf_call[[ names(dots)[i] ]] <- get_expr(dots[[i]])
+  for (i in seq_along(dots)) {
+    mf_call[[names(dots)[i]]] <- get_expr(dots[[i]])
+  }
 
   # setup contrasts
-  if (any(names(dots) == "contrasts"))
+  if (any(names(dots) == "contrasts")) {
     contrasts <- eval_tidy(dots[["contrasts"]])
-  else
+  } else {
     contrasts <- NULL
+  }
 
   # For new data, save the expression to create offsets (if any)
-  if (any(names(dots) == "offset"))
+  if (any(names(dots) == "offset")) {
     offset_expr <- get_expr(dots[["offset"]])
-  else
+  } else {
     offset_expr <- NULL
+  }
 
   mod_frame <- eval_tidy(mf_call)
   mod_terms <- attr(mod_frame, "terms")
@@ -78,20 +81,22 @@
   y <- model.response(mod_frame, type = "any")
 
   # if y is a numeric vector, model.response() added names
-  if(is.atomic(y)) {
+  if (is.atomic(y)) {
     names(y) <- NULL
   }
 
   w <- as.vector(model.weights(mod_frame))
-  if (!is.null(w) && !is.numeric(w))
+  if (!is.null(w) && !is.numeric(w)) {
     rlang::abort("`weights` must be a numeric vector")
+  }
 
   offset <- as.vector(model.offset(mod_frame))
   if (!is.null(offset)) {
-    if (length(offset) != nrow(mod_frame))
+    if (length(offset) != nrow(mod_frame)) {
       rlang::abort(
         glue::glue("The offset data should have {nrow(mod_frame)} elements.")
-        )
+      )
+    }
   }
 
   if (indicators != "none") {
@@ -103,13 +108,13 @@
       options(contrasts = new_contr)
     }
     x <- model.matrix(mod_terms, mod_frame, contrasts)
-
   } else {
     # this still ignores -vars in formula
     x <- model.frame(mod_terms, data)
     y_cols <- attr(mod_terms, "response")
-    if (length(y_cols) > 0)
-      x <- x[,-y_cols, drop = FALSE]
+    if (length(y_cols) > 0) {
+      x <- x[, -y_cols, drop = FALSE]
+    }
   }
 
   if (remove_intercept) {
@@ -124,8 +129,9 @@
     )
 
   if (composition == "data.frame") {
-    if (is.matrix(y))
+    if (is.matrix(y)) {
       y <- as.data.frame(y)
+    }
     res <-
       list(
         x = as.data.frame(x),
@@ -140,8 +146,9 @@
   } else {
     # Since a matrix is requested, try to convert y but check
     # to see if it is possible
-    if (will_make_matrix(y))
+    if (will_make_matrix(y)) {
       y <- as.matrix(y)
+    }
     res <-
       list(
         x = x,
@@ -164,12 +171,12 @@
 #' @keywords internal
 #' @export
 .convert_form_to_xy_new <- function(object,
-                                   new_data,
-                                   na.action = na.pass,
-                                   composition = "data.frame") {
-
-  if (!(composition %in% c("data.frame", "matrix")))
+                                    new_data,
+                                    na.action = na.pass,
+                                    composition = "data.frame") {
+  if (!(composition %in% c("data.frame", "matrix"))) {
     rlang::abort("`composition` should be either 'data.frame' or 'matrix'.")
+  }
 
   mod_terms <- object$terms
   mod_terms <- delete.response(mod_terms)
@@ -183,29 +190,38 @@
   # If offset was done at least once in-line
   if (!is.null(offset_cols)) {
     offset <- rep(0, nrow(new_data))
-    for (i in offset_cols)
+    for (i in offset_cols) {
       offset <- offset +
-        eval_tidy(attr(mod_terms, "variables")[[i + 1]],
-                  new_data) # use na.action here and below?
-  } else offset <- NULL
+        eval_tidy(
+          attr(mod_terms, "variables")[[i + 1]],
+          new_data
+        ) # use na.action here and below?
+    }
+  } else {
+    offset <- NULL
+  }
 
   if (!is.null(object$offset_expr)) {
-    if (is.null(offset))
+    if (is.null(offset)) {
       offset <- rep(0, nrow(new_data))
+    }
     offset <- offset + eval_tidy(object$offset_expr, new_data)
   }
 
   new_data <-
-    model.frame(mod_terms,
-                new_data,
-                na.action = na.action,
-                xlev = object$xlevels)
+    model.frame(
+      mod_terms,
+      new_data,
+      na.action = na.action,
+      xlev = object$xlevels
+    )
 
   cl <- attr(mod_terms, "dataClasses")
-  if (!is.null(cl))
+  if (!is.null(cl)) {
     .checkMFClasses(cl, new_data)
+  }
 
-  if(object$options$indicators != "none") {
+  if (object$options$indicators != "none") {
     if (object$options$indicators == "one_hot") {
       old_contr <- options("contrasts")$contrasts
       on.exit(options(contrasts = old_contr))
@@ -217,15 +233,16 @@
       model.matrix(mod_terms, new_data, contrasts.arg = object$contrasts)
   }
 
-  if(object$options$remove_intercept) {
+  if (object$options$remove_intercept) {
     new_data <- new_data[, colnames(new_data) != "(Intercept)", drop = FALSE]
   }
 
-  if (composition == "data.frame")
+  if (composition == "data.frame") {
     new_data <- as.data.frame(new_data)
-  else {
-    if (will_make_matrix(new_data))
+  } else {
+    if (will_make_matrix(new_data)) {
       new_data <- as.matrix(new_data)
+    }
   }
   list(x = new_data, offset = offset)
 }
@@ -247,21 +264,23 @@
 #'
 #' @importFrom dplyr bind_cols
 .convert_xy_to_form_fit <- function(x,
-                                   y,
-                                   weights = NULL,
-                                   y_name = "..y",
-                                   remove_intercept = TRUE) {
-  if (is.vector(x))
+                                    y,
+                                    weights = NULL,
+                                    y_name = "..y",
+                                    remove_intercept = TRUE) {
+  if (is.vector(x)) {
     rlang::abort("`x` cannot be a vector.")
+  }
 
-  if(remove_intercept) {
+  if (remove_intercept) {
     x <- x[, colnames(x) != "(Intercept)", drop = FALSE]
   }
 
   rn <- rownames(x)
 
-  if (!is.data.frame(x))
+  if (!is.data.frame(x)) {
     x <- as.data.frame(x)
+  }
 
   if (is.matrix(y)) {
     y <- as.data.frame(y)
@@ -277,14 +296,17 @@
   form <- make_formula(names(x), names(y))
 
   x <- bind_cols(x, y)
-  if(!is.null(rn) & !inherits(x, "tbl_df"))
+  if (!is.null(rn) & !inherits(x, "tbl_df")) {
     rownames(x) <- rn
+  }
 
   if (!is.null(weights)) {
-    if (!is.numeric(weights))
+    if (!is.numeric(weights)) {
       rlang::abort("`weights` must be a numeric vector")
-    if (length(weights) != nrow(x))
+    }
+    if (length(weights) != nrow(x)) {
       rlang::abort(glue::glue("`weights` should have {nrow(x)} elements"))
+    }
   }
 
   res <- list(
@@ -301,8 +323,9 @@
 #' @export
 .convert_xy_to_form_new <- function(object, new_data) {
   new_data <- new_data[, object$x_var, drop = FALSE]
-  if (!is.data.frame(new_data))
+  if (!is.data.frame(new_data)) {
     new_data <- as.data.frame(new_data)
+  }
   new_data
 }
 

R/descriptors.R

@@ -116,9 +116,9 @@ get_descr_df <- function(formula, data) {
 
   tmp_dat <-
     .convert_form_to_xy_fit(formula,
-                           data,
-                           indicators = "none",
-                           remove_intercept = TRUE)
+                            data,
+                            indicators = "none",
+                            remove_intercept = TRUE)
 
   if(is.factor(tmp_dat$y)) {
     .lvls <- function() {