Add linter CI

.github/workflows/linter.yml

@@ -0,0 +1,71 @@
+# This workflow uses actions that are not certified by GitHub.
+# They are provided by a third-party and are governed by
+# separate terms of service, privacy policy, and support
+# documentation.
+#
+# See https://github.com/r-lib/actions/tree/master/examples#readme for
+# additional example workflows available for the R community.
+
+# ======================================================== #
+# Determines when the action is triggered                  #
+# ======================================================== #
+
+on: [push, pull_request]
+name: linter
+
+# ======================================================== #
+# Determine actions to take                                #
+# ======================================================== #
+
+jobs:
+  lint:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+        - name: Checking out the repository
+          uses: actions/checkout@v2
+
+        - name: Setting up R
+          uses: r-lib/actions/setup-r@v1
+          with:
+            use-public-rspm: true
+
+        - name: Installing dependencies
+          uses: r-lib/actions/setup-r-dependencies@v1
+          with:
+            extra-packages: lintr
+
+        - name: Picking on the coding style
+          run: |
+            library(lintr)
+            excluded_files <- list(
+              "inst/examples/compute_consensus_example.R",
+              "inst/examples/compute_mallows_example.R",
+              "inst/examples/compute_mallows_mixtures_example.R",
+              "inst/examples/compute_posterior_intervals_example.R",
+              "inst/examples/estimate_partition_function_example.R",
+              "inst/examples/generate_constraints_example.R",
+              "inst/examples/generate_initial_ranking_example.R",
+              "inst/examples/generate_transitive_closure_example.R",
+              "inst/examples/label_switching_example.R",
+              "inst/examples/obs_freq_example.R",
+              "inst/examples/plot_top_k_example.R",
+              "inst/examples/plot.BayesMallows_example.R"
+            )
+            style_rules <- list(
+              absolute_path_linter, assignment_linter, closed_curly_linter,
+              commas_linter, commented_code_linter, cyclocomp_linter,
+              equals_na_linter, function_left_parentheses_linter,
+              infix_spaces_linter, line_length_linter, no_tab_linter,
+              nonportable_path_linter, object_length_linter,
+              open_curly_linter, paren_brace_linter, pipe_continuation_linter,
+              semicolon_terminator_linter, seq_linter, single_quotes_linter,
+              spaces_inside_linter, spaces_left_parentheses_linter,
+              T_and_F_symbol_linter, todo_comment_linter,
+              trailing_blank_lines_linter, trailing_whitespace_linter,
+              undesirable_function_linter, undesirable_operator_linter,
+              unneeded_concatenation_linter
+            )
+            lint_package(linters = style_rules, exclusions = excluded_files)
+          shell: Rscript {0}

R/RcppExports.R

@@ -649,4 +649,3 @@ metropolis_hastings_aug_ranking_pseudo <- function(alpha, rho, n_items, partial_
 metropolis_hastings_rho <- function(alpha, n_items, rankings, metric, rho, leap_size) {
     .Call(`_BayesMallows_metropolis_hastings_rho`, alpha, n_items, rankings, metric, rho, leap_size)
 }
-

R/all_topological_sorts.R

@@ -1,10 +1,10 @@
 # Translation to R of C++ and Python code found here
 # https://www.geeksforgeeks.org/all-topological-sorts-of-a-directed-acyclic-graph/
-all_topological_sorts <- function(graph, path, discovered, n_items){
+all_topological_sorts <- function(graph, path, discovered, n_items) {
   flag <- FALSE
 
-  for(i in seq_len(n_items)){
-    if(attr(graph, "indegree")[[i]] == 0 && !discovered[[i]]){
+  for (i in seq_len(n_items)) {
+    if (attr(graph, "indegree")[[i]] == 0 && !discovered[[i]]) {
       attr(graph, "indegree")[graph[[i]]] <- attr(graph, "indegree")[graph[[i]]] - 1
 
       path <- c(path, i)
@@ -18,5 +18,5 @@ all_topological_sorts <- function(graph, path, discovered, n_items){
       flag <- TRUE
     }
   }
-  if(length(path) == n_items) print(path)
+  if (length(path) == n_items) print(path)
 }

R/assess_convergence.R

@@ -26,64 +26,64 @@
 #' @export
 #'
 assess_convergence <- function(model_fit, parameter = "alpha", items = NULL,
-                               assessors = NULL){
+                               assessors = NULL) {
 
   stopifnot(inherits(model_fit, "BayesMallows") ||
               inherits(model_fit, "BayesMallowsMixtures"))
 
-  if(parameter == "alpha") {
-    if(inherits(model_fit, "BayesMallows")){
+  if (parameter == "alpha") {
+    if (inherits(model_fit, "BayesMallows")) {
       m <- model_fit$alpha
       trace_alpha(m, FALSE)
-    } else if(inherits(model_fit, "BayesMallowsMixtures")){
-      m <- do.call(rbind, lapply(model_fit, function(x){
+    } else if (inherits(model_fit, "BayesMallowsMixtures")) {
+      m <- do.call(rbind, lapply(model_fit, function(x) {
         dplyr::mutate(x$alpha,
                       cluster = as.character(.data$cluster),
                       n_clusters = x$n_clusters)
       }))
       trace_alpha(m, TRUE)
       }
 
-  } else if(parameter == "rho"){
-    if(inherits(model_fit, "BayesMallows")){
+  } else if (parameter == "rho") {
+    if (inherits(model_fit, "BayesMallows")) {
       trace_rho(model_fit, items)
-    } else if(inherits(model_fit, "BayesMallowsMixtures")){
+    } else if (inherits(model_fit, "BayesMallowsMixtures")) {
       cowplot::plot_grid(plotlist = lapply(model_fit, trace_rho, clusters = TRUE, items = items))
     }
 
-  } else if(parameter == "Rtilde") {
+  } else if (parameter == "Rtilde") {
 
-    if(inherits(model_fit, "BayesMallows")){
+    if (inherits(model_fit, "BayesMallows")) {
       trace_rtilde(model_fit, items, assessors)
-    } else if(inherits(model_fit, "BayesMallowsMixtures")){
+    } else if (inherits(model_fit, "BayesMallowsMixtures")) {
       stop("Trace plots of augmented data not supported for BayesMallowsMixtures. Please rerun each component k using the k-th list element.")
     }
-  } else if (parameter == "cluster_probs"){
-    if(inherits(model_fit, "BayesMallows")){
+  } else if (parameter == "cluster_probs") {
+    if (inherits(model_fit, "BayesMallows")) {
       m <- model_fit$cluster_probs
-    } else if(inherits(model_fit, "BayesMallowsMixtures")){
-      m <- do.call(rbind, lapply(model_fit, function(x){
+    } else if (inherits(model_fit, "BayesMallowsMixtures")) {
+      m <- do.call(rbind, lapply(model_fit, function(x) {
         dplyr::mutate(x$cluster_probs,
                       cluster = as.character(.data$cluster),
                       n_clusters = x$n_clusters)
       }))
     }
     trace_cluster_probs(m)
 
-  } else if (parameter == "theta"){
+  } else if (parameter == "theta") {
       trace_theta(model_fit)
   } else {
     stop("parameter must be either \"alpha\", \"rho\", \"augmentation\", \"cluster_probs\", or \"theta\".")
   }
 }
 
-trace_alpha <- function(m, clusters){
+trace_alpha <- function(m, clusters) {
   # Create the diagnostic plot for alpha
   p <- ggplot2::ggplot(m, ggplot2::aes(x = .data$iteration, y = .data$value)) +
     ggplot2::xlab("Iteration") +
     ggplot2::ylab(expression(alpha))
 
-  if(!clusters){
+  if (!clusters) {
     p <- p + ggplot2::geom_line()
   } else {
     p <- p +
@@ -97,16 +97,16 @@ trace_alpha <- function(m, clusters){
   return(p)
 }
 
-trace_rho <- function(model_fit, items, clusters = model_fit$n_clusters > 1){
+trace_rho <- function(model_fit, items, clusters = model_fit$n_clusters > 1) {
 
-  if(is.null(items) && model_fit$n_items > 5){
+  if (is.null(items) && model_fit$n_items > 5) {
     message("Items not provided by user. Picking 5 at random.")
     items <- sample.int(model_fit$n_items, 5)
   } else if (is.null(items) && model_fit$n_items > 0) {
     items <- seq.int(from = 1, to = model_fit$n_items)
   }
 
-  if(!is.character(items)){
+  if (!is.character(items)) {
     items <- model_fit$items[items]
   }
 
@@ -118,40 +118,40 @@ trace_rho <- function(model_fit, items, clusters = model_fit$n_clusters > 1){
     ggplot2::xlab("Iteration") +
     ggplot2::ylab(expression(rho))
 
-  if(clusters){
+  if (clusters) {
     p <- p + ggplot2::facet_wrap(ggplot2::vars(.data$cluster))
   }
 
   return(p)
 }
 
 
-trace_rtilde <- function(model_fit, items, assessors, ...){
+trace_rtilde <- function(model_fit, items, assessors, ...) {
 
 
-  if(!model_fit$save_aug){
+  if (!model_fit$save_aug) {
     stop("Please rerun with compute_mallows with save_aug = TRUE")
   }
 
-  if(is.null(items) && model_fit$n_items > 5){
+  if (is.null(items) && model_fit$n_items > 5) {
     message("Items not provided by user. Picking 5 at random.")
     items <- sample.int(model_fit$n_items, 5)
   } else if (is.null(items) && model_fit$n_items > 0) {
     items <- seq.int(from = 1, to = model_fit$n_items)
   }
 
-  if(is.null(assessors) && model_fit$n_assessors > 5){
+  if (is.null(assessors) && model_fit$n_assessors > 5) {
     message("Assessors not provided by user. Picking 5 at random.")
     assessors <- sample.int(model_fit$n_assessors, 5)
   } else if (is.null(assessors) && model_fit$n_assessors > 0) {
     assessors <- seq.int(from = 1, to = model_fit$n_assessors)
-  } else if(!is.null(assessors)) {
-    if(length(setdiff(assessors, seq(1, model_fit$n_assessors, 1))) > 0) {
+  } else if (!is.null(assessors)) {
+    if (length(setdiff(assessors, seq(1, model_fit$n_assessors, 1))) > 0) {
       stop("assessors vector must contain numeric indices between 1 and the number of assessors")
     }
   }
 
-  if(is.factor(model_fit$augmented_data$item) && is.numeric(items)){
+  if (is.factor(model_fit$augmented_data$item) && is.numeric(items)) {
     items <- levels(model_fit$augmented_data$item)[items]
   }
   df <- dplyr::filter(model_fit$augmented_data,
@@ -169,7 +169,7 @@ trace_rtilde <- function(model_fit, items, assessors, ...){
 }
 
 
-trace_cluster_probs <- function(m){
+trace_cluster_probs <- function(m) {
 
   ggplot2::ggplot(m, ggplot2::aes(x = .data$iteration, y = .data$value,
                                color = .data$cluster)) +
@@ -184,8 +184,8 @@ trace_cluster_probs <- function(m){
 }
 
 
-trace_theta <- function(model_fit){
-  if(is.null(model_fit$theta) || length(model_fit$theta) == 0){
+trace_theta <- function(model_fit) {
+  if (is.null(model_fit$theta) || length(model_fit$theta) == 0) {
     stop("Theta not available. Run compute_mallows with error_model = 'bernoulli'.")
   }
   # Create the diagnostic plot for theta

R/assign_cluster.R

@@ -30,12 +30,12 @@
 #'
 #' @export
 #'
-assign_cluster <- function(model_fit, burnin = model_fit$burnin, soft = TRUE, expand = FALSE){
+assign_cluster <- function(model_fit, burnin = model_fit$burnin, soft = TRUE, expand = FALSE) {
 
-  if(is.null(burnin)){
+  if (is.null(burnin)) {
     stop("Please specify the burnin.")
   }
-  if(is.null(model_fit$cluster_assignment)){
+  if (is.null(model_fit$cluster_assignment)) {
     stop("Rerun compute_mallows with save_clus=TRUE.")
   }
   stopifnot(burnin < model_fit$nmc)
@@ -53,8 +53,8 @@ assign_cluster <- function(model_fit, burnin = model_fit$burnin, soft = TRUE, ex
   df <- dplyr::ungroup(df)
   df <- dplyr::rename(df, cluster = .data$value)
 
-  if(expand){
-    df <- do.call(rbind, lapply(split(df, f = df$assessor), function(dd){
+  if (expand) {
+    df <- do.call(rbind, lapply(split(df, f = df$assessor), function(dd) {
       dd2 <- merge(dd, expand.grid(cluster = unique(df$cluster)), by = "cluster",
                    all = TRUE)
       dd2$assessor <- unique(dd$assessor)
@@ -78,7 +78,7 @@ assign_cluster <- function(model_fit, burnin = model_fit$burnin, soft = TRUE, ex
   # Join map back onto df
   df <- dplyr::inner_join(df, map, by = "assessor")
 
-  if(!soft){
+  if (!soft) {
     df <- dplyr::filter(df, .data$cluster == .data$map_cluster)
     df <- dplyr::select(df, -.data$cluster)
   }