linting fixes

mjskay · Feb 7, 2024 · 01923f0 · 01923f0
1 parent f664623
commit 01923f0
Show file tree

Hide file tree

Showing 15 changed files with 178 additions and 117 deletions.
diff --git a/.lintr b/.lintr
@@ -2,6 +2,7 @@ linters: all_linters(
     assignment_linter = NULL,
     commas_linter(allow_trailing = TRUE),
     consecutive_assertion_linter = NULL,
+    duplicate_argument_linter(except = c("mutate", "transmute", "c")),
     implicit_integer_linter = NULL,
     infix_spaces_linter(exclude_operators = c("/", "*")),
     keyword_quote_linter = NULL,
@@ -12,9 +13,9 @@ linters: all_linters(
     object_name_linter(
       styles = c("snake_case", "symbols"),
       regexes = c(
-        misc = "^(F_x|x_1_hat,x_n_hat)$",
-        CamelCase = "^(RankCorr.*|.*Geom.*|.*Stat.*|Scale.*|K|.*Pr.*)$",
-        dot.case = "^(na\\.rm|lower\\.tail|log\\.p)$",
+        misc = "^(F_x|x_1_hat,x_n_hat|R_inv|Amat|Aind)$",
+        CamelCase = "^(RankCorr.*|.*Geom.*|.*Stat.*|Scale.*|Position.*|K|.*Pr.*)$",
+        dot.case = "^(na\\.rm|na\\.translate|na\\.value|lower\\.tail|log\\.p)$",
         bandwidth = "^(bandwidth_.*)$"
       )
     ),
@@ -34,5 +35,6 @@ linters: all_linters(
       defaults = all_undesirable_operators,
       "<-" = "House style is to use `=`, not `<-`, for assignment."
     )),
-    unnecessary_concatenation_linter(allow_single_expression = FALSE)
+    unnecessary_concatenation_linter(allow_single_expression = FALSE),
+    unnecessary_nesting_linter = NULL
   )
diff --git a/R/density.R b/R/density.R
@@ -373,18 +373,18 @@ density_histogram = auto_partial(name = "density_histogram", function(
   # work as expected if 1 is a bin edge.
   eps = min(diff(h$breaks)/4, 2*.Machine$double.eps)
 
-  if (!outline_bars) {
+  if (outline_bars) {
+    # have to return to 0 in between each bar so that bar outlines are drawn
+    input = as.vector(rbind(input_1, input_1, input_1 + eps, input_, input_, input_2 - eps, input_2, input_2))
+    pdf = as.vector(rbind(0, h$density, h$density, h$density, h$density, h$density, h$density, 0))
+    cdf = as.vector(rbind(cdf_1, cdf_1, cdf_1, cdf_1, cdf_, cdf_2, cdf_2, cdf_2))
+  } else {
     # as.vector(rbind(x, y)) interleaves vectors x and y, giving
     # us the bin endpoints --- then just need to repeat the same value of density
     # for both endpoints of the same bin
     input = as.vector(rbind(input_1, input_1 + eps, input_, input_, input_2 - eps, input_2))
     pdf = rep(h$density, each = 6)
     cdf = as.vector(rbind(cdf_1, cdf_1, cdf_1, cdf_, cdf_2, cdf_2))
-  } else {
-    # have to return to 0 in between each bar so that bar outlines are drawn
-    input = as.vector(rbind(input_1, input_1, input_1 + eps, input_, input_, input_2 - eps, input_2, input_2))
-    pdf = as.vector(rbind(0, h$density, h$density, h$density, h$density, h$density, h$density, 0))
-    cdf = as.vector(rbind(cdf_1, cdf_1, cdf_1, cdf_1, cdf_, cdf_2, cdf_2, cdf_2))
   }
 
   structure(list(

diff --git a/R/distributions.R b/R/distributions.R
@@ -204,8 +204,8 @@ distr_levels = function(dist) {
   if (inherits(dist, "rvar_factor")) {
     levels(dist)
   } else if (inherits(dist, "distribution")) {
-    levels = lapply(vec_data(dist), distr_levels)
-    unique(do.call(c, levels))
+    levs = lapply(vec_data(dist), distr_levels)
+    unique(do.call(c, levs))
   } else if (inherits(dist, "dist_categorical")) {
     as.character(dist[["x"]] %||% seq_along(dist[["p"]]))
   } else if (inherits(dist, "ggdist__wrapped_categorical")) {
@@ -218,7 +218,7 @@ distr_levels = function(dist) {
       unique(s)
     }
   } else {
-    warning("Don't know how to determine the levels of distribution: ", format(dist))
+    warning0("Don't know how to determine the levels of distribution: ", format(dist))
     NULL
   }
 }
@@ -233,7 +233,7 @@ distr_probs = function(dist) {
   } else if (inherits(dist, "ggdist__wrapped_categorical")) {
     distr_probs(dist[["wrapped_dist"]])
   } else {
-    warning("Don't know how to determine the category probabilities of distribution: ", format(dist))
+    warning0("Don't know how to determine the category probabilities of distribution: ", format(dist))
     NULL
   }
 }

diff --git a/R/geom_dotsinterval.R b/R/geom_dotsinterval.R
@@ -173,13 +173,14 @@ makeContent.dots_grob = function(x) {
       subguide_params[, c(y, ymin, ymax, "side", "justification", "scale")],
       c(y, "side", "justification", "scale"),
       function(d) {
-        if (nrow(unique(d)) > 1) {
+        if (nrow(unique(d)) > 1) {                                 # nocov start
+          # this should not be possible
           cli_abort(
             "Cannot draw a subguide for the dot count axis when multiple dots
              geometries with different parameters are drawn on the same axis.",
             class = "ggdist_incompatible_subguides"
           )
-        }
+        }                                                          # nocov end
         d = d[1, ]
 
         dot_height = binwidth * heightratio / stackratio
@@ -553,9 +554,9 @@ GeomDotsinterval = ggproto("GeomDotsinterval", GeomSlabinterval,
     # so size can only occur in cases where colour is also set (so we can just check colour)
     if (
       params$show_slab &&
-      any(!is.na(data[,c(
-        "fill","alpha","slab_fill","slab_colour","slab_linewidth","slab_size",
-        "slab_linetype","slab_alpha","slab_shape"
+      !all(is.na(data[, c(
+        "fill", "alpha", "slab_fill", "slab_colour", "slab_linewidth", "slab_size",
+        "slab_linetype", "slab_alpha", "slab_shape"
       )]))
     ) {
       s_key_data = self$override_slab_aesthetics(key_data)
@@ -603,7 +604,8 @@ GeomDots = ggproto("GeomDots", GeomDotsinterval,
     s_data$fill = s_data[["slab_fill"]] %||% s_data[["fill"]]
     s_data$fill = apply_colour_ramp(s_data[["fill"]], s_data[["fill_ramp"]])
     s_data$alpha = s_data[["slab_alpha"]] %||% s_data[["alpha"]]
-    s_data$linewidth = s_data[["slab_linewidth"]] %||% s_data[["slab_size"]] %||% s_data[["linewidth"]] %||% s_data[["size"]]
+    s_data$linewidth = s_data[["slab_linewidth"]] %||% s_data[["slab_size"]] %||%
+      s_data[["linewidth"]] %||% s_data[["size"]]
     s_data$shape = s_data[["slab_shape"]] %||% s_data[["shape"]]
     s_data
   },

diff --git a/R/geom_lineribbon.R b/R/geom_lineribbon.R
@@ -227,7 +227,9 @@ GeomLineribbon = ggproto("GeomLineribbon", AbstractGeom,
     # draw all the ribbons
     ribbon_grobs = data %>%
       dlply_(grouping_columns, function(d) {
-        group_grobs = list(GeomRibbon$draw_panel(transform(d, linewidth = NA), panel_scales, coord, flipped_aes = flipped_aes))
+        group_grobs = list(
+          GeomRibbon$draw_panel(transform(d, linewidth = NA), panel_scales, coord, flipped_aes = flipped_aes)
+        )
         list(
           order = mean(d[["order"]], na.rm = TRUE),
           grobs = group_grobs
@@ -273,25 +275,29 @@ stepify = function(df, x = "x", direction = "hv") {
   # sort by x and double up all rows in the data frame
   step_df = df[rep(order(df[[x]]), each = 2),]
 
-  if (direction == "hv") {
-    # horizontal-to-vertical step => lead x and drop last row
-    step_df[[x]] = lead(step_df[[x]])
-    step_df[-2*n,]
-  } else if (direction == "vh") {
-    # vertical-to-horizontal step => lag x and drop first row
-    step_df[[x]] = lag(step_df[[x]])
-    step_df[-1,]
-  } else if (direction == "mid") {
-    # mid step => last value in each pair is matched with the first value in the next pair,
-    # then we set their x position to their average.
-    # Need to repeat the last value one more time to make it work
-    step_df[2*n + 1,] = step_df[2*n,]
-
-    x_i = seq_len(n)*2
-    mid_x = (step_df[x_i, x] + step_df[x_i + 1, x]) / 2
-
-    step_df[x_i, x] = mid_x
-    step_df[x_i + 1, x] = mid_x
-    step_df
-  }
+  switch(direction,
+    hv = {
+      # horizontal-to-vertical step => lead x and drop last row
+      step_df[[x]] = lead(step_df[[x]])
+      step_df[-2*n,]
+    },
+    vh = {
+      # vertical-to-horizontal step => lag x and drop first row
+      step_df[[x]] = lag(step_df[[x]])
+      step_df[-1,]
+    },
+    mid = {
+      # mid step => last value in each pair is matched with the first value in the next pair,
+      # then we set their x position to their average.
+      # Need to repeat the last value one more time to make it work
+      step_df[2*n + 1,] = step_df[2*n,]
+
+      x_i = seq_len(n)*2
+      mid_x = (step_df[x_i, x] + step_df[x_i + 1, x]) / 2
+
+      step_df[x_i, x] = mid_x
+      step_df[x_i + 1, x] = mid_x
+      step_df
+    }
+  )
 }
diff --git a/R/geom_slabinterval.R b/R/geom_slabinterval.R
@@ -348,7 +348,8 @@ override_point_aesthetics = function(self, p_data, size_domain, size_range, fatt
   p_data$fill = p_data[["point_fill"]] %||% p_data[["fill"]]
   p_data$alpha = p_data[["point_alpha"]] %||% p_data[["alpha"]]
   # TODO: insert fatten_point deprecation warning
-  p_data$size = p_data[["point_size"]] %||% (fatten_point * transform_size(p_data[["interval_size"]] %||% p_data[["size"]], size_domain, size_range))
+  p_data$size = p_data[["point_size"]] %||%
+    (fatten_point * transform_size(p_data[["interval_size"]] %||% p_data[["size"]], size_domain, size_range))
   p_data
 }
 
@@ -357,16 +358,21 @@ override_interval_aesthetics = function(self, i_data, size_domain, size_range) {
   i_data$colour = apply_colour_ramp(i_data[["colour"]], i_data[["colour_ramp"]])
   i_data$alpha = i_data[["interval_alpha"]] %||% i_data[["alpha"]]
   # TODO: insert interval_size deprecation warning
-  i_data$linewidth = transform_size(i_data[["linewidth"]] %||% i_data[["interval_size"]] %||% i_data[["size"]], size_domain, size_range)
+  i_data$linewidth = transform_size(
+    i_data[["linewidth"]] %||% i_data[["interval_size"]] %||% i_data[["size"]], size_domain, size_range
+  )
   i_data$linetype = i_data[["interval_linetype"]] %||% i_data[["linetype"]]
   i_data
 }
 
 transform_size = function(size, size_domain, size_range) {
   pmax(
-    (size - size_domain[[1]]) / (size_domain[[2]] - size_domain[[1]]) *
-      (size_range[[2]] - size_range[[1]]) + size_range[[1]],
-    0)
+    (size - size_domain[[1]]) /
+      (size_domain[[2]] - size_domain[[1]]) *
+      (size_range[[2]] - size_range[[1]]) +
+      size_range[[1]],
+    0
+  )
 }
 
 
@@ -618,7 +624,7 @@ GeomSlabinterval = ggproto("GeomSlabinterval", AbstractGeom,
     slab_colour = NA
   ),
 
-  required_aes = c("x|y"),
+  required_aes = "x|y",
 
   optional_aes = c(
     "ymin", "ymax", "xmin", "xmax", "width", "height", "thickness"
@@ -671,9 +677,9 @@ GeomSlabinterval = ggproto("GeomSlabinterval", AbstractGeom,
 
     # INTERVAL PARAMS
     interval_size_domain = glue_doc('
-      A length-2 numeric vector giving the minimum and maximum of the values of the `size` and `linewidth` aesthetics that will be
-      translated into actual sizes for intervals drawn according to `interval_size_range` (see the documentation
-      for that argument.)
+      A length-2 numeric vector giving the minimum and maximum of the values of the `size` and `linewidth` aesthetics
+      that will be translated into actual sizes for intervals drawn according to `interval_size_range` (see the
+      documentation for that argument.)
       '),
     interval_size_range = glue_doc('
       A length-2 numeric vector. This geom scales the raw size aesthetic values when drawing interval and point
@@ -810,7 +816,7 @@ GeomSlabinterval = ggproto("GeomSlabinterval", AbstractGeom,
         # ensure thickness is a thickness-type vector so it is not normalized again
         data$thickness = normalize_thickness(as_thickness(data$thickness))
       },
-      stop('`normalize` must be "all", "panels", "xy", groups", or "none", not "', params$normalize, '"')
+      stop0('`normalize` must be "all", "panels", "xy", groups", or "none", not "', params$normalize, '"')
     )
 
     ggproto_parent(AbstractGeom, self)$draw_layer(data, params, layout, coord)
@@ -975,7 +981,7 @@ group_slab_data_by = function(
   define_orientation_variables(orientation)
 
   aesthetics = intersect(aesthetics, names(slab_data))
-  groups = factor(do.call(paste, slab_data[,aesthetics]))
+  groups = factor(do.call(paste, slab_data[, aesthetics]))
 
   if (nlevels(groups) > 1) {
     # need to split into groups based on varying aesthetics
@@ -1013,7 +1019,7 @@ group_slab_data_by = function(
     slab_data
   }
   bottomleft = function() {
-    slab_data = slab_data[nrow(slab_data):1,]
+    slab_data = slab_data[rev(seq_len(nrow(slab_data))), ]
     slab_data[[y]] = slab_data[[ymin]]
     slab_data
   }

diff --git a/R/geom_spike.R b/R/geom_spike.R
@@ -192,7 +192,7 @@ GeomSpike = ggproto("GeomSpike", GeomSlab,
 
     point_key = if (
       !all(is.na(s_key_data$size) | s_key_data$size == 0) && (
-        !all(is.na(data[c("size","stroke","shape","alpha")])) ||
+        !all(is.na(data[c("size", "stroke", "shape", "alpha")])) ||
         # only draw point for `fill` aesthetic if a shape that has a fill colour is used
         (!all(is.na(data[c("fill", "fill_ramp")])) && length(intersect(data$shape, 21:25)) > 0) ||
         (!all(is.na(data[c("fill", "fill_ramp")])) && length(intersect(data$shape, 21:25)) > 0)

diff --git a/R/parse_dist.R b/R/parse_dist.R
@@ -101,9 +101,12 @@ parse_dist = function(
 #' @rdname parse_dist
 #' @export
 parse_dist.default = function(object, ...) {
-  stop(
-    "Objects of type ", deparse0(class(object)), " are not currently supported by `parse_dist`.\n",
-    "A character vector or a data frame are expected.\n"
+  cli_abort(
+    c(
+      "{.arg object} must be a character vector, factor, data frame, or {.help brms::prior} object.",
+      "x" = "{.arg object} was {.type {object}}"
+    ),
+    class = "ggdist_unsupported_type"
   )
 }
 
@@ -148,7 +151,15 @@ parse_dist.data.frame = function(
 
 #' @rdname parse_dist
 #' @export
-parse_dist.character = function(object, ..., dist = ".dist", args = ".args", dist_obj = ".dist_obj", package = NULL, to_r_names = TRUE) {
+parse_dist.character = function(
+  object,
+  ...,
+  dist = ".dist",
+  args = ".args",
+  dist_obj = ".dist_obj",
+  package = NULL,
+  to_r_names = TRUE
+) {
   package = package %||% parent.frame()
 
   na_spec = tibble( # for unparseable specs
@@ -247,11 +258,17 @@ check_dist_name = function(dist) {
     is.na(mget(paste0("q", dist), inherits = TRUE, ifnotfound = NA))
   failed_names = dist[invalid & !is.na(dist)]
   if (length(failed_names) > 0) {
-    warning(
-      "The following distribution names were not recognized and were ignored: \n",
-      "    ", paste(failed_names, collapse = ", "), "\n",
-      "  See help('stat_slabinterval') for information on specifying distribution names.",
-      if ("lkjcorr" %in% failed_names) "\n  See help('marginalize_lkjcorr') for help visualizing LKJ distributions."
+    cli_warn(
+      c(
+        "The following distribution names were not recognized and were ignored: {failed_names}",
+        "i" = "See {.emph Details} in the {.help stat_slabinterval} documentation for information
+          on specifying distribution names.",
+        if ("lkjcorr" %in% failed_names) c(
+          "i" = "See the {.help marginalize_lkjcorr} documentation for help visualizing LKJ
+            distributions."
+        )
+      ),
+      class = "ggdist_unsupported_distribution_name"
     )
   }
   dist[invalid] = NA