Update files

.Rbuildignore

@@ -13,3 +13,4 @@ cran-comments.md
 .Rprofile
 meta_data.yaml
 ^\.github$
+^\.lintr

R/attrition.R

@@ -1,5 +1,5 @@
-get_attrition_coords <- function(labels, n_included, space = 1, percent = FALSE) {
-  n_total <- n_included[1]
+get_attrition_coords <- function(labels, n_included, space = 1L, percent = FALSE) {
+  n_total <- n_included[1L]
   n_excluded <- stats::na.omit(n_included - dplyr::lead(n_included))
 
   label <- glue::glue("{labels}\nN = {n_included}")
@@ -15,13 +15,13 @@
     label_excl = label_excl
   ) %>%
     dplyr::mutate(
-      label_heights = nchar(label) - nchar(gsub("\n", "", label)),
-      label_position_y = dplyr::lag(cumsum(label_heights + space), default = 0),
-      label_position_x = 0,
+      label_heights = nchar(label) - nchar(gsub("\n", "", label, fixed = TRUE)),
+      label_position_y = dplyr::lag(cumsum(label_heights + space), default = 0L),
+      label_position_x = 0L,
       arrow_end_position_y = dplyr::lead(label_position_y),
-      excl_position_x = 0,
-      excl_end_position_x = 40,
-      excl_position_y = dplyr::lag(arrow_end_position_y) - (space / 2)
+      excl_position_x = 0L,
+      excl_end_position_x = 40L,
+      excl_position_y = dplyr::lag(arrow_end_position_y) - (space / 2L)
     )
   attr(dt, "space") <- space
   dt
@@ -31,7 +31,7 @@
   max_y_lim <- max(attrition_coords$label_position_y) + max(attrition_coords$label_heights)
   space <- attr(attrition_coords, "space")
   if (is.null(space)) {
-    space <- 1
+    space <- 1L
   }
   ggplot2::ggplot(attrition_coords) +
     ggplot2::geom_segment(
@@ -44,14 +44,15 @@
     ) +
     ggplot2::geom_label(
       ggplot2::aes(label = label, x = label_position_x, y = label_position_y),
-      label.r = ggplot2::unit(0, "lines"), vjust = "top", size = 12/ggplot2::.pt, na.rm = TRUE
+      label.r = ggplot2::unit(0L, "lines"), vjust = "top", size = 12L / ggplot2::.pt, na.rm = TRUE
     ) +
     ggplot2::geom_label(
-      ggplot2::aes(label = label_excl, x = excl_end_position_x, y = excl_position_y), label.r = ggplot2::unit(0, "lines"),
-      hjust = "left", size = 12/ggplot2::.pt, na.rm = TRUE
+      ggplot2::aes(label = label_excl, x = excl_end_position_x, y = excl_position_y),
+      label.r = ggplot2::unit(0L, "lines"),
+      hjust = "left", size = 12L / ggplot2::.pt, na.rm = TRUE
     ) +
     ggplot2::scale_y_continuous(limits = c(max_y_lim + space, -space), trans = "reverse") +
-    ggplot2::scale_x_continuous(limits = c(-35, 60)) +
+    ggplot2::scale_x_continuous(limits = c(-35L, 60L)) +
     ggplot2::theme(
       panel.grid.major = ggplot2::element_blank(),
       panel.grid.minor = ggplot2::element_blank(),
@@ -69,7 +70,7 @@
       purrr::imap(~paste(.y, " = ", .x)) %>%
       paste(collapse = ", ")
   } else if (is.vector(value)) {
-    value <- paste(value, collapse = ", ")
+    value <- toString(value)
   }
   glue::glue("Filter: {name} ({value_name} = [{value}])")
 }
@@ -92,8 +93,8 @@
     if (is.null(pkey)) {
       return("Initial dataset")
     } else {
-      dataset <- pkey[[1]]$dataset
-      dataset_pkey <- pkey[[1]]$key
+      dataset <- pkey[[1L]]$dataset
+      dataset_pkey <- pkey[[1L]]$key
       return(glue::glue("{dataset}\n primary key: {paste(dataset_pkey, collapse = ', ')}"))
     }
   }
@@ -106,7 +107,7 @@
       purrr::map(~names(.[["data_keys"]])) %>%
       unlist() %>%
       collapse::funique()
-    if (length(dependent_datasets) > 0) {
+    if (length(dependent_datasets) > 0L) {
       bind_keys_section <- glue::glue(
         "\nData linked with external datasets: {paste(dependent_datasets, collapse = ', ')}",
         .trim = FALSE
@@ -134,4 +135,3 @@
   data_stats %>%
     purrr::map_int("n_rows")
 }
-

R/bind_keys.R

@@ -71,14 +71,16 @@ primary_keys <- function(...) {
 #' - `data_key` - requires to provide two parameters:
 #' \itemize{
 #'   \item{\code{dataset} - Name of the dataset existing in Source.}
-#'   \item{\code{key} - Single character string or vector storing column names that are keys, which should be used to describe relation.}
+#'   \item{\code{key} - Single character string or vector storing column names that are keys,
+#'     which should be used to describe relation.}
 #' }
 #' For example `data_key('books', 'author_id')`.
 #'
 #' - `bind_key` - requires to provide two obligatory parameters
 #' \itemize{
 #'   \item{\code{update} - Data key describing which table should be updated.}
-#'   \item{\code{...} - \strong{Triggering data keys}. One or more data keys describing on which dataset(s) the one in `update` is dependent.}
+#'   \item{\code{...} - \strong{Triggering data keys}. One or more data keys describing on which dataset(s)
+#'     the one in `update` is dependent.}
 #' }
 #' The output of `bind_key` function is named \strong{binding key}.
 #' `bind_key` offers two extra parameters `post` and `activate`.

R/cohort_methods.R

@@ -89,7 +89,7 @@
                           post = get_hook("post_add_step_hook")
                         )) {
 
-      new_step_id <- as.character(as.integer(self$last_step_id()) + 1)
+      new_step_id <- as.character(as.integer(self$last_step_id()) + 1L)
 
       run_hooks(hook$pre, self, private, new_step_id)
 
@@ -121,7 +121,7 @@
           filters = purrr::map(filters, get_filter_state, extra_fields = NULL)
         )
       } else {
-        step_config <- self$get_state(step_id, json = FALSE)[[1]]
+        step_config <- self$get_state(step_id, json = FALSE)[[1L]]
         step_config$step <- next_step(step_id)
       }
 
@@ -150,7 +150,7 @@
       run_hooks(hook$pre, self, private, step_id)
 
       step_id <- as.character(step_id)
-      clear_data_ids <- steps_range(step_id, rev(names(private$steps))[1])
+      clear_data_ids <- steps_range(step_id, rev(names(private$steps))[1L])
       private$steps[[step_id]] <- NULL
       private$cache[clear_data_ids] <- NULL
       private$data_objects[clear_data_ids] <- NULL
@@ -191,7 +191,7 @@
       filter_id <- as.character(filter_id)
 
       private$steps[[step_id]]$filters[[filter_id]] <- NULL
-      if (length(private$steps[[step_id]]$filters) == 0) {
+      if (length(private$steps[[step_id]]$filters) == 0L) {
         self$remove_step(step_id, run_flow)
       } else {
         if (run_flow) {
@@ -307,11 +307,11 @@
     #' @param state List or JSON string containing steps and filters configuration.
     #' @param modifier Function two parameters combining the previous and provided state.
     #'   The returned state is then restored.
-    restore = function(state, modifier = function(prev_state, state) {state},
+    restore = function(state, modifier = function(prev_state, state) state,
                        run_flow = FALSE, hook = list(
-      pre = get_hook("pre_restore_hook"),
-      post = get_hook("post_restore_hook")
-    )) {
+                         pre = get_hook("pre_restore_hook"),
+                         post = get_hook("post_restore_hook")
+                       )) {
 
       self$attributes$pre_restore_state <- self$get_state(json = FALSE)
 
@@ -322,7 +322,8 @@
       }
 
       if (is.character(state)) {
-        state <- jsonlite::fromJSON(txt = state, simplifyVector = TRUE, simplifyMatrix = FALSE, simplifyDataFrame = FALSE)
+        state <- jsonlite::fromJSON(txt = state, simplifyVector = TRUE,
+                                    simplifyMatrix = FALSE, simplifyDataFrame = FALSE)
       }
 
       state <- modifier(self$attributes$pre_restore_state, state)
@@ -341,10 +342,9 @@
             filter_state$range <- na_fix(filter_state$range)
             filter_state$range <- as.Date(filter_state$range)
           }
-
           if (filter_state$type == "datetime_range") {
             filter_state$range <- na_fix(filter_state$range)
-            if (length(filter_state$range) == 0) filter_state$range <- NULL
+            if (length(filter_state$range) == 0L) filter_state$range <- NULL
             filter_state$range <- as.POSIXct(filter_state$range, origin = "1970-01-01 UTC")
           }
           add_filter(
@@ -421,7 +421,7 @@
         ...
       )
       for (active_state in active_states) {
-        attrition_labels[length(attrition_labels) + 1] <- .get_attrition_label(
+        attrition_labels[length(attrition_labels) + 1L] <- .get_attrition_label(
           source = self$get_source(),
           step_id = active_state$step,
           step_filters = purrr::map(active_state$filters, get_filter_meta),
@@ -504,11 +504,11 @@
     #' @param mark_step Include information which filtering step is performed.
     #' @param ... Other parameters passed to \link[formatR]{tidy_source}.
     get_code = function(
-      include_source = TRUE, include_methods = c(".pre_filtering", ".post_filtering", ".run_binding"),
-      include_action = c("pre_filtering", "post_filtering", "run_binding"),
-      modifier = .repro_code_tweak, mark_step = TRUE, ...) {
+        include_source = TRUE, include_methods = c(".pre_filtering", ".post_filtering", ".run_binding"),
+        include_action = c("pre_filtering", "post_filtering", "run_binding"),
+        modifier = .repro_code_tweak, mark_step = TRUE, ...) {
 
-      source_type <- class(private$source)[1]
+      source_type <- class(private$source)[1L]
       # todo improve
       fun_args <- environment()
       code_params <- c(
@@ -620,7 +620,7 @@
       # todo code include once?
       res_quote <- combine_expressions(unlist(code_components_df$expr))
       formatR::tidy_source(
-        text = as.character(res_quote)[-1],
+        text = as.character(res_quote)[-1L],
         ...
       )
     },
@@ -631,7 +631,7 @@
                         hook = list(pre = get_hook("pre_run_flow_hook"), post = get_hook("post_run_flow_hook"))) {
       run_hooks(hook$pre, self, private)
       if (missing(min_step)) {
-        min_step <- 1
+        min_step <- 1L
       }
       min_step <- min(length(private$data_objects), as.integer(min_step)) # make sure all steps data is evaluated
       steps_to_execute <- steps_range(min_step, length(private$steps))
@@ -720,7 +720,7 @@
     #' @description
     #' Print defined steps configuration.
     describe_state = function() {
-      if (length(private$steps) == 0) {
+      if (length(private$steps) == 0L) {
         cat("No steps configuration found.")
       } else {
         private$steps %>% purrr::walk(print_step)
@@ -1234,6 +1234,6 @@
 #' @seealso \link{cohort-methods}
 #' @export
 description <- function(x, field, step_id, filter_id,
-                      modifier = getOption("cb_help_modifier", default = function(x) x)) {
+                        modifier = getOption("cb_help_modifier", default = function(x) x)) {
   x$show_help(field = field, step_id = step_id, filter_id = filter_id, modifier = modifier)
 }

R/filter.R

@@ -13,8 +13,8 @@
 #' @export
 .gen_id <- function() {
   paste0(
-    paste0(sample(LETTERS, 5, TRUE), collapse = ""),
-    round(as.numeric(Sys.time()) * 1000)
+    paste(sample(LETTERS, 5L, TRUE), collapse = ""),
+    round(as.numeric(Sys.time()) * 1000L)
   )
 }
 
@@ -53,16 +53,19 @@
 #' @param name Filter name.
 #' @param input_param Name of parameter responsible for providing filtering value.
 #' @param filter_data Function of `data_object` parameter defining filtering logic on Source data object.
-#' @param get_stats Function of `data_object` and `name` parameters defining what and how data statistics should be calculated.
+#' @param get_stats Function of `data_object` and `name` parameters
+#' defining what and how data statistics should be calculated.
 #' @param plot_data Function of `data_object` parameter defining how filter data should be plotted.
-#' @param get_params Function of `name` parameter returning filter parameters (if names is skipped all the parameters are returned).
+#' @param get_params Function of `name` parameter returning
+#' filter parameters (if names is skipped all the parameters are returned).
 #' @param get_data Function of `data_object` returning filter related data.
-#' @param get_defaults Function of `data_object` and `cache_object` parameters returning default `input_param` parameter value.
+#' @param get_defaults Function of `data_object` and `cache_object` parameters
+#' returning default `input_param` parameter value.
 #' @return A list of filter specific values and methods (`def_filter`) or no value (`new_filter`).
 #'
 #' @export
 def_filter <- function(type, id = .gen_id(), name = id, input_param = NULL,
-  filter_data, get_stats, plot_data, get_params, get_data, get_defaults) {
+                       filter_data, get_stats, plot_data, get_params, get_data, get_defaults) {
 
   structure(
     list(
@@ -95,13 +98,12 @@
   ))
   extra_params_assign <- ""
   if (!identical(extra_params, "")) {
-    extra_params_assign <- paste0(paste(
-      glue::glue("{extra_params} = {extra_params}"),
-      collapse = ", "
+    extra_params_assign <- paste0(toString(
+      glue::glue("{extra_params} = {extra_params}")
     ), ",")
-    extra_params <- paste0(paste(extra_params, collapse = ", "), ",")
+    extra_params <- paste0(toString(extra_params), ",")
   }
-  file = file.path(getwd(), glue::glue("filter_{filter_type}_{source_type}.R"))
+  file <- file.path(getwd(), glue::glue("filter_{filter_type}_{source_type}.R"))
   writeLines(
     do.call(glue::glue, as.list(template_content)),
     con = file
@@ -310,12 +312,12 @@
 #' @rdname filter-types
 #' @export
 filter.datetime_range <- function(type, id, name, ..., description = NULL,
-                                   active = getOption("cb_active_filter", default = TRUE)) {
+                                  active = getOption("cb_active_filter", default = TRUE)) {
   args <- append(
     environment() %>% as.list() %>% purrr::keep(~ !is.symbol(.x)),
     list(...)
   )
-  
+
   .as_constructor(
     function(source) {
       do.call(
@@ -396,4 +398,3 @@
     }
   }
 }
-

R/list_operators.R

@@ -1,9 +1,9 @@
 adjust_names <- function(list_obj) {
-  if (length(list_obj) == 0) {
+  if (length(list_obj) == 0L) {
     # removed the last existing object
     return(list())
   }
-  names(list_obj) <- as.character(1:length(list_obj))
+  names(list_obj) <- as.character(seq_along(list_obj))
   return(list_obj)
 }
 
@@ -13,14 +13,14 @@
 
 last_item <- function(list_obj) {
   list_length <- length(list_obj)
-  if (list_length == 0) {
+  if (list_length == 0L) {
     return(NULL)
   }
   list_obj[[list_length]]
 }
 
 step_filter_state <- function(steps, method = length, raw = FALSE) {
-  if (length(steps) == 0) {
+  if (length(steps) == 0L) {
     if (raw) return(steps)
     return(method(steps))
   }
@@ -52,12 +52,12 @@
 #' @export
 .get_method <- function(name) {
   found_methods <- utils::getAnywhere(name)
-  if (length(found_methods$objs) == 0) {
+  if (length(found_methods$objs) == 0L) {
     return(NULL)
   }
   namespace <- gsub(
     "namespace:", "", fixed = TRUE,
-    grep("namespace:", found_methods$where, value = TRUE, fixed = TRUE)[1]
+    grep("namespace:", found_methods$where, value = TRUE, fixed = TRUE)[1L]
   )
   utils::getFromNamespace(name, namespace)
 }