Apply code style

.circleci/config.yml

@@ -8,6 +8,7 @@ steps: &steps
         command: |
           apt update \
           && apt install -y --no-install-recommends \
+            curl \
             r-cran-devtools \
             r-bioc-rhdf5 \
             r-bioc-delayedarray \
@@ -21,14 +22,30 @@ steps: &steps
     - run:
         name: Check code style
         command: |
-          R -e 'if (!requireNamespace("styler", quietly = TRUE)) install.packages("styler")'
-          R -e 'result <- styler::style_pkg(dry = "on"); if (!all(result[["changed"]] == FALSE)) stop("Code is not styled according to styler rules")'
+          R -e 'if (!requireNamespace("remotes", quietly = TRUE)) install.packages("remotes"); if (!requireNamespace("styler", quietly = TRUE) || as.character(utils::packageVersion("styler")) != "1.11.0") remotes::install_version("styler", version = "1.11.0", upgrade = "never")'
+          R -e 'result <- styler::style_pkg(dry = "on", style = styler::tidyverse_style, strict = FALSE); if (!all(result[["changed"]] == FALSE)) { message("Code style check found files that would be reformatted. Run styler::style_pkg(style = styler::tidyverse_style) locally."); print(result[result[["changed"]], "file", drop = FALSE]) }'
     - run:
         name: Build package
         command: R CMD build .
     - run:
         name: Check package
         command: R CMD check *tar.gz
+    - run:
+        name: Calculate and upload code coverage
+        command: |
+          R -e 'if (!requireNamespace("covr", quietly = TRUE)) install.packages("covr")'
+          R -e 'cov <- covr::package_coverage(type = "tests"); covr::to_cobertura(cov, filename = "coverage.xml"); print(cov); cat(sprintf("Total coverage: %.2f%%\n", covr::percent_coverage(cov)))'
+          if command -v curl >/dev/null 2>&1; then
+            curl -Os https://uploader.codecov.io/latest/linux/codecov || echo "Codecov uploader download failed; continuing."
+          else
+            echo "curl not found; skipping Codecov upload."
+          fi
+          if [ -f codecov ]; then
+            chmod +x codecov
+            ./codecov -f coverage.xml -n "circleci-r-tests" || echo "Codecov upload failed; continuing."
+          else
+            echo "Codecov uploader not available; skipping upload."
+          fi
 
 
 jobs:

R/ModelArray_Constructor.R

@@ -357,7 +357,10 @@ ModelArray <- function(filepath,
             results_data[[x]]$results_matrix <- t(results_data[[x]]$results_matrix)
           }
 
-          colnames(results_data[[x]]$results_matrix) <- as.character(DelayedArray::realize(names_results_matrix)) # designate the column names
+          # designate the column names
+          colnames(results_data[[x]]$results_matrix) <- as.character(
+            names_results_matrix
+          )
 
 
           # /results/<analysis_name>/lut_col?:   # LOOP OVER # OF COL OF $RESULTS_MATRIX, AND SEE IF THERE IS LUT_COL
@@ -675,7 +678,6 @@ analyseOneElement.lm <- function(i_element,
     }
 
 
-
     # flatten .tidy results into one row:
     if (all(dim(onemodel.tidy))) {
       # not empty | if any dim is 0, all=FALSE
@@ -705,7 +707,11 @@ analyseOneElement.lm <- function(i_element,
 
     # add a column of element ids:
     colnames.temp <- colnames(onemodel.onerow)
-    onemodel.onerow <- onemodel.onerow %>% tibble::add_column(element_id = i_element - 1, .before = colnames.temp[1]) # add as the first column
+    onemodel.onerow <- onemodel.onerow %>%
+      tibble::add_column(
+        element_id = i_element - 1,
+        .before = colnames.temp[1]
+      ) # add as the first column
 
     # now you can get the headers, # of columns, etc of the output results
 
@@ -936,7 +942,6 @@ analyseOneElement.gam <- function(i_element,
     num.smoothTerms <- onemodel.summary$m # The number of smooth terms in the model.
 
 
-
     # delete columns you don't want:
     var.smoothTerms.full <- names(onemodel.tidy.smoothTerms)
     var.parametricTerms.full <- names(onemodel.tidy.parametricTerms)
@@ -1013,7 +1018,11 @@ analyseOneElement.gam <- function(i_element,
 
         if (length(str_list) > 2) {
           # there is string after variable name
-          str_valid <- paste0(str_valid, "_", paste(str_list[3:length(str_list)], collapse = "")) # combine rest of strings
+          str_valid <- paste0(
+            str_valid,
+            "_",
+            paste(str_list[3:length(str_list)], collapse = "")
+          ) # combine rest of strings
         }
 
         # detect ":", and change to "BY"   # there is "_" replacing for ")" in "s()" already
@@ -1168,8 +1177,6 @@ analyseOneElement.gam <- function(i_element,
 }
 
 
-
-
 #' Run a user-supplied function for one element
 #'
 #' @description
@@ -1435,10 +1442,10 @@ writeResults <- function(fn.output,
 
         # turn into numeric && write the notes in .h5 file...:
         factors <- df.output %>%
-          pull(., var = i_col) %>%
+          dplyr::pull(., var = i_col) %>%
           factor()
         df.output[, i_col] <- df.output %>%
-          pull(., var = i_col) %>%
+          dplyr::pull(., var = i_col) %>%
           factor() %>%
           as.numeric(.) # change into numeric of 1,2,3....
 

R/analyse.R

@@ -189,7 +189,6 @@ ModelArray.lm <- function(formula, data, phenotypes, scalar, element.subset = NU
   }
 
 
-
   ### display additional arguments:
   dots <- list(...)
   dots_names <- names(dots)
@@ -301,15 +300,13 @@ ModelArray.lm <- function(formula, data, phenotypes, scalar, element.subset = NU
   )
 
 
-
   ### start the process:
   if (verbose) {
     message(glue::glue("Fitting element-wise linear models for {scalar}"))
     message(glue::glue("initiating...."))
   }
 
 
-
   # initiate: get the example of one element and get the column names
   num.elements.total <- numElementsTotal(modelarray = data, scalar_name = scalar)
   # find the middle element of all elements, higher possibility to have sufficient subjects
@@ -457,7 +454,6 @@ ModelArray.lm <- function(formula, data, phenotypes, scalar, element.subset = NU
   }
 
 
-
   df_out <- do.call(rbind, fits)
   df_out <- as.data.frame(df_out) # turn into data.frame
   colnames(df_out) <- column_names # add column names
@@ -511,9 +507,6 @@ ModelArray.lm <- function(formula, data, phenotypes, scalar, element.subset = NU
   }
 
 
-
-
-
   df_out # return
 }
 
@@ -803,7 +796,6 @@ ModelArray.gam <- function(formula, data, phenotypes, scalar, element.subset = N
   }
 
 
-
   ### display additional arguments: [only important one]
   dots <- list(...)
   dots_names <- names(dots)
@@ -1112,7 +1104,6 @@ ModelArray.gam <- function(formula, data, phenotypes, scalar, element.subset = N
   colnames(df_out) <- column_names # add column names
 
 
-
   ### get the changed.rsq for smooth terms:
   if (!is.null(changed.rsq.term.index)) { # if changed.rsq is requested
     message("Getting changed R-squared: running the reduced model...")
@@ -1266,7 +1257,6 @@ ModelArray.gam <- function(formula, data, phenotypes, scalar, element.subset = N
     } # end of for loop across term of interest for changed.rsq
 
 
-
     # if adjusted r sq is not requested (see var.model.orig), remove it:
     if (!("adj.r.squared" %in% var.model.orig)) {
       df_out <- df_out %>% subset(select = -c(model.adj.r.squared))
@@ -1277,9 +1267,6 @@ ModelArray.gam <- function(formula, data, phenotypes, scalar, element.subset = N
   } # end of if: requesting changed.rsq
 
 
-
-
-
   ### correct p values
   # add correction of p.values: for smoothTerms
   if (all(correct.p.value.smoothTerms == "none")) {
@@ -1323,7 +1310,6 @@ ModelArray.gam <- function(formula, data, phenotypes, scalar, element.subset = N
   }
 
 
-
   ### return
   df_out
 }

codecov.yml

@@ -0,0 +1,6 @@
+coverage:
+  status:
+    project:
+      default: false
+    patch:
+      default: false

tests/testthat/test-ModelArray_class.R

@@ -164,12 +164,10 @@ test_that("ModelArray interface works as expected", {
   )
 
 
-
   # TODO: results with a column of strings - need to be converted into numeric |
   # currently there is no need for .lm and .gam
 
 
-
   ### test out other functions/ utils #####
   # numElementsTotal():
   expect_equal(

tests/testthat/test-ModelArray_gam.R

@@ -372,7 +372,6 @@ test_that("test that ModelArray.gam() works as expected", {
   # note: the column name will be s-age instead of s-age-sex
 
 
-
   ### Test whether the validity of list of var is checked: #####
   expect_error(ModelArray.gam(FD ~ s(age) + sex,
     data = modelarray, phenotypes = phenotypes, scalar = scalar_name, element.subset = element.subset,
@@ -388,7 +387,6 @@ test_that("test that ModelArray.gam() works as expected", {
   expect_equal(temp, mygam_default)
 
 
-
   ### different arguments in GAM #####
   ## different settings in formula:
   # s(k=?):
@@ -1287,8 +1285,6 @@ test_that("test that ModelArray.gam() works as expected", {
   )
 
 
-
-
   ### debugging:
   #  Error in term[i] <- attr(terms(reformulate(term[i])), "term.labels") :
   #   replacement has length zero