added R linting and changed R code to comma-first (fixes microsoft#2373)

.ci/lint_r.sh

@@ -0,0 +1,23 @@
+#!/bin/bash
+
+# [description]
+#     Lint R code in a directory for style
+#     problems
+# [usage]
+#     ./.ci/lint_r.sh $(pwd)
+
+SOURCE_DIR=${1}
+
+# failure is a natural part of life
+set -e
+
+echo ""
+echo "Checking code for R style problems..."
+echo ""
+
+    Rscript $(pwd)/.ci/lint_r_code.R \
+        --source-dir ${SOURCE_DIR}
+
+echo ""
+echo "Done checking code for style problems."
+echo ""

.ci/lint_r_code.R

@@ -0,0 +1,64 @@
+
+library(argparse)
+library(lintr)
+
+parser <- argparse::ArgumentParser()
+parser$add_argument(
+    "--source-dir"
+    , type = "character"
+    , help = "Fully-qualified directory to search for R files"
+)
+args <- parser$parse_args()
+
+SOURCE_DIR <- args[["source_dir"]]
+
+FILES_TO_LINT <- list.files(
+    path = SOURCE_DIR
+    , pattern = "\\.r$"
+    , all.files = TRUE
+    , ignore.case = TRUE
+    , full.names = TRUE
+    , recursive = TRUE
+    , include.dirs = FALSE
+)
+
+LINTERS_TO_USE <- list(
+    "open_curly" = lintr::open_curly_linter
+    , "closed_curly" = lintr::closed_curly_linter
+    , "tabs" = lintr::no_tab_linter
+    , "spaces" = lintr::infix_spaces_linter
+    , "trailing_blank" = lintr::trailing_blank_lines_linter
+    , "trailing_white" = lintr::trailing_whitespace_linter
+    , "long_lines" = lintr::line_length_linter(length = 120)
+)
+
+cat(sprintf("Found %i R files to lint\n", length(FILES_TO_LINT)))
+
+results <- c()
+
+for (r_file in FILES_TO_LINT){
+
+    this_result <- lintr::lint(
+        filename = r_file
+        , linters = LINTERS_TO_USE
+        , cache = FALSE
+    )
+
+    cat(sprintf(
+        "Found %i linting errors in %s\n"
+        , length(this_result)
+        , r_file
+    ))
+
+    results <- c(results, this_result)
+
+}
+
+issues_found <- length(results)
+
+if (issues_found > 0){
+    cat("\n")
+    print(results)
+}
+
+quit(save = "no", status = issues_found)

.ci/test.sh

@@ -59,6 +59,13 @@ if [[ $TASK == "lint" ]]; then
     exit 0
 fi
 
+if [[ $TASK == "rlint" ]]; then
+    conda install -c r \
+        r-argparse \
+        r-lintr
+    ./.ci/lint_r.sh $(pwd)
+fi
+
 if [[ $TASK == "if-else" ]]; then
     conda install -q -y -n $CONDA_ENV numpy
     mkdir $BUILD_DIRECTORY/build && cd $BUILD_DIRECTORY/build && cmake "${CMAKE_OPTS[@]}" .. && make lightgbm -j4 || exit -1

.travis.yml

@@ -18,6 +18,7 @@ env:
     - TASK=bdist
     - TASK=if-else
     - TASK=lint
+    - TASK=rlint
     - TASK=check-docs
     - TASK=mpi METHOD=source
     - TASK=mpi METHOD=pip

R-package/R/callback.R

@@ -39,7 +39,11 @@ cb.reset.parameters <- function(new_params) {
     # since changing them would simply wreck some chaos
     not_allowed <- c("num_class", "metric", "boosting_type")
     if (any(pnames %in% not_allowed)) {
-      stop("Parameters ", paste0(pnames[pnames %in% not_allowed], collapse = ", "), " cannot be changed during boosting")
+      stop(
+        "Parameters "
+        , paste0(pnames[pnames %in% not_allowed], collapse = ", ")
+        , " cannot be changed during boosting"
+      )
     }
 
     # Check parameter names
@@ -244,8 +248,14 @@ cb.record.evaluation <- function() {
       name <- eval_res$name
 
       # Store evaluation data
-      env$model$record_evals[[data_name]][[name]]$eval <- c(env$model$record_evals[[data_name]][[name]]$eval, eval_res$value)
-      env$model$record_evals[[data_name]][[name]]$eval_err <- c(env$model$record_evals[[data_name]][[name]]$eval_err, eval_err)
+      env$model$record_evals[[data_name]][[name]]$eval <- c(
+        env$model$record_evals[[data_name]][[name]]$eval
+        , eval_res$value
+      )
+      env$model$record_evals[[data_name]][[name]]$eval_err <- c(
+        env$model$record_evals[[data_name]][[name]]$eval_err
+        , eval_err
+      )
 
     }
 
@@ -391,7 +401,9 @@ cb.early.stop <- function(stopping_rounds, verbose = TRUE) {
 }
 
 # Extract callback names from the list of callbacks
-callback.names <- function(cb_list) { unlist(lapply(cb_list, attr, "name")) }
+callback.names <- function(cb_list) {
+  unlist(lapply(cb_list, attr, "name"))
+}
 
 add.cb <- function(cb_list, cb) {