Merge pull request #760 from njtierney/add-flint-i759

using flint package to establish better lints and fixes

.Rbuildignore

@@ -50,3 +50,7 @@ LICENSE
 ^__autograph*
 ^testlog
 ^data-raw$
+
+
+# flint files
+^flint$

.github/workflows/R-CMD-check.yaml

@@ -19,7 +19,7 @@ defaults:
 jobs:
   R-CMD-check:
     name: ${{ matrix.os }}, tf-${{ matrix.tf }}, R-${{ matrix.r}}
-    timeout-minutes: 30
+    timeout-minutes: 45
     strategy:
       fail-fast: false
       matrix:
@@ -37,7 +37,9 @@ jobs:
 
     steps:
 
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-pandoc@v2
 
       - uses: r-lib/actions/setup-r@v2
         id: setup-r
@@ -46,8 +48,6 @@ jobs:
           Ncpus: '2L'
           use-public-rspm: true
 
-      - uses: r-lib/actions/setup-pandoc@v2
-
       - name: Get Date
         id: get-date
         shell: bash
@@ -62,6 +62,7 @@ jobs:
           path: ${{ env.R_LIBS_USER }}
           key: ${{ matrix.os }}-${{ steps.setup-r.outputs.installed-r-version }}-${{ steps.get-date.outputs.year-week }}-1
 
+
       - name: Install remotes
         if: steps.r-package-cache.outputs.cache-hit != 'true'
         run: install.packages("remotes")
@@ -77,6 +78,12 @@ jobs:
             sudo $cmd
           done < <(Rscript -e "writeLines(remotes::system_requirements('$ID-$VERSION_ID'))")
 
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::rcmdcheck local::. rstudio/reticulate
+          cache-version: 4
+          upgrade: 'TRUE'
+
       - name: Install package + deps
         run: remotes::install_local(dependencies = TRUE, force = TRUE)
 
@@ -91,18 +98,22 @@ jobs:
       - name: Install rcmdcheck
         run: remotes::install_cran("rcmdcheck")
 
-      - name: Check
-        run: rcmdcheck::rcmdcheck(args = '--no-manual', error_on = 'warning', check_dir = 'check')
-
-      - name: Show testthat output
-        if: always()
-        shell: bash
-        run: find check -name 'testthat.Rout*' -exec cat '{}' \; || true
-
-      - name: Don't use tar from old Rtools to store the cache
-        if: ${{ runner.os == 'Windows' && startsWith(steps.install-r.outputs.installed-r-version, '3') }}
-        shell: bash
-        run: echo "C:/Program Files/Git/usr/bin" >> $GITHUB_PATH
+      - uses: r-lib/actions/check-r-package@v2
+        with:
+          upload-snapshots: true
+
+      # - name: Check
+      #   run: rcmdcheck::rcmdcheck(args = '--no-manual', error_on = 'warning', check_dir = 'check')
+      #
+      # - name: Show testthat output
+      #   if: always()
+      #   shell: bash
+      #   run: find check -name 'testthat.Rout*' -exec cat '{}' \; || true
+      #
+      # - name: Don't use tar from old Rtools to store the cache
+      #   if: ${{ runner.os == 'Windows' && startsWith(steps.install-r.outputs.installed-r-version, '3') }}
+      #   shell: bash
+      #   run: echo "C:/Program Files/Git/usr/bin" >> $GITHUB_PATH
 
       - name: Check on single core machine
         if: runner.os != 'Windows'

R/checkers.R

@@ -38,17 +38,15 @@ check_tf_version <- function(alert = c("none",
     correct_tfp = have_tfp()
   )
 
-  if ((all(requirements_valid))) {
-
-    if (!greta_stash$python_has_been_initialised) {
+  py_not_init <- !greta_stash$python_has_been_initialised
+  requirements_valid_py_not_init <- all(requirements_valid) && py_not_init
+  if (requirements_valid_py_not_init) {
 
       cli_process_done(
         msg_done = "Initialising python and checking dependencies ... done!")
       cat("\n")
       greta_stash$python_has_been_initialised <- TRUE
 
-    }
-
   }
 
   if (!all(requirements_valid)) {
@@ -100,7 +98,7 @@ check_dims <- function(...,
 
   # as text, for printing
   dims_paste <- vapply(dim_list, paste, "", collapse = "x")
-  dims_text <- paste(dims_paste, collapse = ", ")
+  dims_text <- toString(dims_paste)
 
   # which are scalars
   scalars <- vapply(elem_list, is_scalar, FALSE)
@@ -734,7 +732,7 @@ check_dependencies_satisfied <- function(target,
 
     # build the message
     if (any(matches)) {
-      names_text <- paste(unmet_names, collapse = ", ")
+      names_text <- toString(unmet_names)
       msg <- cli::format_error(
         message = c(
           "Please provide values for the following {length(names_text)} \\
@@ -1972,7 +1970,7 @@ check_is_greta_array <- function(x,
 check_missing_infinite_values <- function(x,
                                           optional,
                                           call = rlang::caller_env()){
-  contains_missing_or_inf <- !optional & any(!is.finite(x))
+  contains_missing_or_inf <- !optional & !all(is.finite(x))
   if (contains_missing_or_inf) {
     cli::cli_abort(
       message = c(

R/distribution.R

@@ -88,19 +88,19 @@
   }
 
   # if distribution isn't scalar, make sure it has the right dimensions
-  ## TODO fix explaining variable
-  if (!is_scalar(value)) {
-    if (!identical(dim(greta_array), dim(value))) {
-      cli::cli_abort(
-        c(
-          "left and right hand sides have different dimensions. ",
-          "The distribution must have dimension of either \\
+  not_scalar <- !is_scalar(value)
+  lhs_rhs_different_dim <- !identical(dim(greta_array), dim(value))
+  not_scalar_different_dims <- not_scalar && lhs_rhs_different_dim
+  if (not_scalar_different_dims) {
+    cli::cli_abort(
+      c(
+        "left and right hand sides have different dimensions. ",
+        "The distribution must have dimension of either \\
           {.val {paste(dim(greta_array), collapse = 'x')}} or {.val 1x1},\\
           but instead has dimension \\
           {.val {paste(dim(value), collapse = 'x')}}"
-        )
       )
-    }
+    )
   }
 
   # assign the new node as the distribution's target

R/extract_replace_combine.R

@@ -100,7 +100,7 @@ NULL
   dummy_out <- do.call(.Primitive("["), call_list, envir = pf)
   rm("._dummy_in", envir = pf)
 
-  if (any(is.na(dummy_out))) {
+  if (anyNA(dummy_out)) {
     cli::cli_abort(
       "subscript out of bounds"
     )
@@ -196,7 +196,7 @@ NULL
   dummy_out <- do.call(.Primitive("["), call_list, envir = pf)
   rm("._dummy_in", envir = pf)
 
-  if (any(is.na(dummy_out))) {
+  if (anyNA(dummy_out)) {
     cli::cli_abort(
       "subscript out of bounds"
     )
@@ -211,7 +211,7 @@ NULL
         "number of items to replace is not a multiple of replacement length"
       )
     } else {
-      replacement <- rep(replacement, length.out = length(index))
+      replacement <- rep_len(replacement, length(index))
     }
   }
 
@@ -542,7 +542,7 @@ length.greta_array <- function(x) {
     dims <- c(dims, 1L)
   }
 
-  if (any(is.na(dims))) {
+  if (anyNA(dims)) {
     cli::cli_abort(
       "the dims contain missing values"
     )

R/inference.R

@@ -249,10 +249,12 @@ mcmc <- function(
     max_samplers <- future::nbrOfWorkers()
 
     # divide chains up between the workers
-    chain_assignment <- sort(rep(
-      seq_len(max_samplers),
-      length.out = chains
-    ))
+    chain_assignment <- sort(
+      rep_len(
+        seq_len(max_samplers),
+        length.out = chains
+    )
+    )
 
     # divide the initial values between them
     initial_values_split <- split(initial_values, chain_assignment)
@@ -336,16 +338,17 @@ run_samplers <- function(samplers,
     plan_is$local &
     !is.null(greta_stash$callbacks)
 
-  ## TODO add explaining variable
-  if (plan_is$parallel & plan_is$local & length(samplers) > 1) {
+  local_parallel_multiple_samplers <- plan_is$parallel &
+    plan_is$local &
+    length(samplers) > 1
+  if (local_parallel_multiple_samplers) {
     cores_text <- compute_text(n_cores, compute_options)
-    msg <- glue::glue(
-      "\n",
-      "running {length(samplers)} samplers in parallel, ",
-      "{cores_text}",
-      "\n\n"
+    cli::cli_inform(
+      message = c("
+      running {length(samplers)} samplers in parallel,
+      {cores_text} \n\n"
+    )
     )
-    message(msg)
   }
 
   is_remote_machine <- plan_is$parallel & !plan_is$local

R/inference_class.R

@@ -557,8 +557,7 @@ sampler <- R6Class(
       }
 
       if (!identical(msg, "")) {
-        msg <- cli::format_message(msg)
-        message(msg)
+        cli::cli_inform(msg)
         cat("\n")
       }
     },
@@ -914,7 +913,6 @@ hmc_sampler <- R6Class(
       return(
         sampler_kernel
       )
-      # nolint end
     },
     sampler_parameter_values = function() {
 
@@ -999,7 +997,6 @@ rwmh_sampler <- R6Class(
       return(
         sampler_kernel
       )
-      # nolint end
     },
     sampler_parameter_values = function() {
       epsilon <- self$parameters$epsilon
@@ -1044,7 +1041,6 @@ slice_sampler <- R6Class(
       return(
         sampler_kernel
       )
-      # nolint end
     },
     sampler_parameter_values = function() {
       max_doublings <- as.integer(self$parameters$max_doublings)

R/node_class.R

@@ -189,7 +189,7 @@ node <- R6Class(
           function(x) x$defined(dag),
           FUN.VALUE = FALSE
         )
-        if (any(!parents_defined)) {
+        if (!all(parents_defined)) {
           parents <- self$list_parents(dag)
           lapply(
             parents[which(!parents_defined)],

R/node_types.R

@@ -223,9 +223,9 @@ variable_node <- R6Class(
       }
 
       bad_limits <- switch(self$constraint,
-        scalar_all_low = any(!is.finite(upper)),
-        scalar_all_high = any(!is.finite(lower)),
-        scalar_all_both = any(!is.finite(lower)) | any(!is.finite(upper)),
+        scalar_all_low = !all(is.finite(upper)),
+        scalar_all_high = !all(is.finite(lower)),
+        scalar_all_both = !all(is.finite(lower)) | !all(is.finite(upper)),
         FALSE
       )
 

R/progress_bar.R

@@ -24,7 +24,7 @@ create_progress_bar <- function(phase, iter, pb_update, width, ...) {
   # pad the frmat so that the width iterations counter is the same for both
   # warmup and sampling
   digit_diff <- nchar(max(iter)) - nchar(iter_this)
-  count_pad <- paste0(rep(" ", 2 * digit_diff), collapse = "")
+  count_pad <- paste(rep(" ", 2 * digit_diff), collapse = "")
 
   # formatting
   format_text <- glue::glue(
@@ -73,7 +73,7 @@ iterate_progress_bar <- function(pb, it, rejects, chains, file = NULL) {
       }
       # pad the end of the line to keep the update bar a consistent width
       pad_char <- pmax(0, 2 - nchar(reject_perc_string))
-      pad <- paste0(rep(" ", pad_char), collapse = "")
+      pad <- paste(rep(" ", pad_char), collapse = "")
 
       reject_text <- glue::glue("| {reject_perc_string}% bad{pad}")
     } else {

R/unknowns_class.R

@@ -56,7 +56,7 @@ print.unknowns <- function(x, ..., n = 10) {
 }
 
 # create an unknowns array from some dimensions
-unknowns <- function(dims = c(1, 1), data = as.numeric(NA)) {
+unknowns <- function(dims = c(1, 1), data = NA_real_) {
   x <- array(data = data, dim = dims)
   as.unknowns(x)
 }

R/utils.R

@@ -991,8 +991,10 @@ is_using_cpu <- function(x){
 `%||%` <- function(x, y) if (is.null(x)) y else x
 
 message_if_using_gpu <- function(compute_options){
-  if (is_using_gpu(compute_options)) {
-    if (getOption("greta_gpu_message") %||% TRUE){
+  gpu_used <- is_using_gpu(compute_options)
+  greta_gpu_message <- getOption("greta_gpu_message") %||% TRUE
+  gpu_used_and_message <- gpu_used && greta_gpu_message
+  if (gpu_used_and_message) {
       cli::cli_inform(
         c(
           "NOTE: When using GPU, the random number seed may not always be \\
@@ -1003,7 +1005,6 @@ message_if_using_gpu <- function(compute_options){
           "{.code options(greta_gpu_message = FALSE)}"
         )
       )
-    }
   }
 }
 
@@ -1169,7 +1170,7 @@ pretty_dim <- function(x){
   x_dim <- dim(x)
   print_dim_x <- x_dim %||% x
 
-  prettied_dim <- paste0(print_dim_x, collapse = "x")
+  prettied_dim <- paste(print_dim_x, collapse = "x")
   prettied_dim
 }
 

R/variable.R

@@ -100,7 +100,7 @@ cholesky_variable <- function(dim, correlation = FALSE) {
 
   # set the printed value to be nicer
   cholesky_value <- unknowns(dim)
-  cholesky_value[lower.tri(cholesky_value, )] <- 0
+  cholesky_value[lower.tri(cholesky_value)] <- 0
   node$value(cholesky_value)
 
   # reeturn as a greta array