[R-package] added R linting and changed R code to comma-first (fixes #…

…2373) (#2437)

.ci/lint_r_code.R

@@ -0,0 +1,62 @@
+
+library(lintr)
+
+args <- commandArgs(
+    trailingOnly = TRUE
+)
+SOURCE_DIR <- args[[1]]
+
+FILES_TO_LINT <- list.files(
+    path = SOURCE_DIR
+    , pattern = "\\.r$"
+    , all.files = TRUE
+    , ignore.case = TRUE
+    , full.names = TRUE
+    , recursive = TRUE
+    , include.dirs = FALSE
+)
+
+# Some linters from the lintr package have not made it to CRAN yet
+# We build lintr from source to address that.
+LINTERS_TO_USE <- list(
+    "closed_curly" = lintr::closed_curly_linter
+    , "infix_spaces" = lintr::infix_spaces_linter
+    , "long_lines" = lintr::line_length_linter(length = 120)
+    , "tabs" = lintr::no_tab_linter
+    , "open_curly" = lintr::open_curly_linter
+    , "spaces_inside" = lintr::spaces_inside_linter
+    , "spaces_left_parens" = lintr::spaces_left_parentheses_linter
+    , "trailing_blank" = lintr::trailing_blank_lines_linter
+    , "trailing_white" = lintr::trailing_whitespace_linter
+)
+
+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

@@ -51,10 +51,17 @@ if [[ $TRAVIS == "true" ]] && [[ $TASK == "check-docs" ]]; then
 fi
 
 if [[ $TASK == "lint" ]]; then
-    conda install -q -y -n $CONDA_ENV pycodestyle pydocstyle
+    conda install -q -y -n $CONDA_ENV \
+        pycodestyle \
+        pydocstyle \
+        r-lintr
     pip install --user cpplint
+    echo "Linting Python code"
     pycodestyle --ignore=E501,W503 --exclude=./compute,./.nuget . || exit -1
     pydocstyle --convention=numpy --add-ignore=D105 --match-dir="^(?!^compute|test|example).*" --match="(?!^test_|setup).*\.py" . || exit -1
+    echo "Linting R code"
+    Rscript ${BUILD_DIRECTORY}/.ci/lint_r_code.R ${BUILD_DIRECTORY} || exit -1
+    echo "Linting C++ code"
     cpplint --filter=-build/c++11,-build/include_subdir,-build/header_guard,-whitespace/line_length --recursive ./src ./include || exit 0
     exit 0
 fi

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
@@ -166,7 +170,7 @@ cb.print.evaluation <- function(period = 1) {
       i <- env$iteration
 
       # Check if iteration matches moduo
-      if ((i - 1) %% period == 0 || is.element(i, c(env$begin_iteration, env$end_iteration ))) {
+      if ( (i - 1) %% period == 0 || is.element(i, c(env$begin_iteration, env$end_iteration))) {
 
         # Merge evaluation string
         msg <- merge.eval.string(env)
@@ -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) {