apply bioc style guide...

...using styler and biocthis::biocstyle

Author: grlloyd

DESCRIPTION

@@ -41,7 +41,8 @@ Imports:
     ggplot2,
     utils,
     rlang,
-    cowplot
+    cowplot,
+    stats
 Collate: 
     'generics.R'
     'zzz.R'

R/AnnotationDb_database.R

@@ -3,10 +3,9 @@
 #' @include annotation_database_class.R
 #' @family annotation databases
 #' @seealso [AnnotationDbi::AnnotationDb]
-AnnotationDb_database <- function(
-        source,
-        table,
-        ...) {
+AnnotationDb_database <- function(source,
+    table,
+    ...) {
     # new object
     out <- struct::new_struct(
         "AnnotationDb_database",

R/AnnotationDb_select_class.R

@@ -3,13 +3,12 @@
 #' @include annotation_source_class.R
 #' @seealso [dplyr::left_join()]
 #' @seealso [AnnotationDbi::select()]
-AnnotationDb_select <- function(
-        database,
-        key_column,
-        key_type,
-        database_columns,
-        drop_na = TRUE,
-        ...) {
+AnnotationDb_select <- function(database,
+    key_column,
+    key_type,
+    database_columns,
+    drop_na = TRUE,
+    ...) {
     out <- struct::new_struct(
         "AnnotationDb_select",
         database = database,
@@ -124,45 +123,45 @@ setMethod(
     definition = function(M, D) {
         # get db
         db <- do.call(`::`, list(M$database, M$database))
-        
+
         # prepare from:to for left join
         by <- M$key_type
         names(by) <- M$key_column
-        
+
         # columns
         if (any(M$database_columns == ".all")) {
             M$database_columns <- AnnotationDbi::columns(db)
         }
-        
+
         # select
         db <- AnnotationDbi::select(
             x = db,
             keys = as.character(D$data[[M$key_column]]),
             columns = M$database_columns,
             keytype = M$key_type
         )
-        
+
         # remove NA
         if (M$drop_na) {
             na <- apply(db, 1, function(x) {
                 any(is.na(x))
             })
             db <- db[!na, ]
         }
-        
+
         # unique rows
         db <- unique(db)
-        
+
         # add the columns
         M2 <- add_columns(
             new_columns = db,
             by = by
         )
         M2 <- model_apply(M2, D)
-        
+
         # assign to object
         M$updated <- predicted(M2)
-        
+
         return(M)
     }
 )

R/BiocFileCache_database_class.R

@@ -2,14 +2,13 @@
 #' @export
 #' @include annotation_database_class.R BiocFileCache_database_helpers.R
 #' @family database
-BiocFileCache_database <- function(
-        source,
-        bfc_path = NULL,
-        resource_name,
-        bfc_fun = .cache_as_is,
-        import_fun = read.csv,
-        offline = FALSE,
-        ...) {
+BiocFileCache_database <- function(source,
+    bfc_path = NULL,
+    resource_name,
+    bfc_fun = .cache_as_is,
+    import_fun = read.csv,
+    offline = FALSE,
+    ...) {
     # new object
     out <- struct::new_struct(
         "BiocFileCache_database",
@@ -119,13 +118,13 @@ setMethod(
         if (is.null(obj$bfc_path)) {
             obj$bfc_path <- BiocFileCache::getBFCOption("CACHE")
         }
-        
+
         # get path
         path <- .get_cached_path(obj)
-        
+
         # read
         df <- obj$import_fun(path)
-        
+
         # return
         return(df)
     }
@@ -144,7 +143,7 @@ setMethod(
         query = obj$source,
         field = "fpath", exact = TRUE
     )$rid
-    
+
     # if not present, then add it
     if (!length(rid)) {
         rid <- names(
@@ -156,11 +155,12 @@ setMethod(
             )
         )
     }
-    
+
     if (rid %in% BiocFileCache::bfcquery(
         bfc,
-        field = "rtype", 
-        query = "web")$rid) {
+        field = "rtype",
+        query = "web"
+    )$rid) {
         # TRUE if newly added or stale
         update <- BiocFileCache::bfcneedsupdate(bfc, rid)
         if (is.na(update)) { # FALSE if NA
@@ -169,8 +169,8 @@ setMethod(
     } else {
         update <- FALSE # cant update if not web resource
     }
-    
-    
+
+
     # download & unzip
     if (update & !obj$offline) {
         BiocFileCache::bfcdownload(
@@ -181,9 +181,9 @@ setMethod(
             verbose = FALSE
         )
     }
-    
+
     # get path
     path <- BiocFileCache::bfcrpath(bfc, rids = rid)
-    
+
     return(path)
 }

R/CompoundDb_source_class.R

@@ -1,9 +1,8 @@
 #' @eval get_description('CompoundDb_source')
 #' @export
 #' @include annotation_source_class.R annotation_source_class.R
-CompoundDb_source <- function(
-        source,
-        tag = "cdb", ...) {
+CompoundDb_source <- function(source,
+    tag = "cdb", ...) {
     out <- struct::new_struct(
         "CompoundDb_source",
         source = source,
@@ -35,27 +34,27 @@ setMethod(
     definition = function(M, D) {
         # check db exists
         stopifnot(file.exists(M$source))
-        
+
         # connect
         db <- CompoundDb::CompDb(M$source)
-        
+
         # get compounds table
         df <- CompoundDb::compounds(
             df,
             return.type = "data.frame",
             columns = compoundVariables(df, includeId = TRUE)
         )
-        
+
         # add tag, id col
         D$tag <- M$tag
         D$id_column <- "compound_id"
-        
+
         # assign to annotation table
         D$data <- df
-        
+
         # add to object
         M$imported <- D
-        
+
         # done
         return(M)
     }

R/MTox700plus_database_class.R

@@ -1,11 +1,10 @@
 #' @eval get_description('MTox700plus_database')
 #' @export
 #' @include annotation_database_class.R BiocFileCache_database_class.R zzz.R
-MTox700plus_database <- function(
-        version = "latest",
-        bfc_path = NULL,
-        resource_name = "MetMashR_MTox700plus",
-        ...) {
+MTox700plus_database <- function(version = "latest",
+    bfc_path = NULL,
+    resource_name = "MetMashR_MTox700plus",
+    ...) {
     # new object
     out <- struct::new_struct(
         "MTox700plus_database",
@@ -58,8 +57,8 @@ MTox700plus_database <- function(
             description = paste0(
                 "The version number of the MTox700+ database to import. ",
                 "Available versions are listed ",
-                '\\href{https://github.com/michabohealthscience/MTox700plus/',
-                'releases}{here}.',
+                "\\href{https://github.com/michabohealthscience/MTox700plus/",
+                "releases}{here}.",
                 ' `version` should match the tag of the release e.g. `"v1.0"`.',
                 ' For convenience `version = "latest"` will always retrieve ',
                 "the most recent release. To prevent unecessary downloads ",
@@ -104,12 +103,12 @@ setMethod(
         httr::stop_for_status(response)
         # otherwise parse content
         J <- httr::content(response, as = "parsed")
-        
+
         # Use BiocFileCache database
         obj$source <- J$zipball_url
         obj$resource_name <- paste0(obj$resource_name, "_", J$tag_name)
         df <- callNextMethod(obj)
-        
+
         # return
         return(df)
     }

R/PathBank_metabolite_database_class.R

@@ -1,11 +1,10 @@
 #' @eval get_description('PathBank_metabolite_database')
 #' @export
 #' @include annotation_database_class.R BiocFileCache_database_class.R
-PathBank_metabolite_database <- function(
-        version = "primary",
-        bfc_path = NULL,
-        resource_name = "MetMashR_PathBank",
-        ...) {
+PathBank_metabolite_database <- function(version = "primary",
+    bfc_path = NULL,
+    resource_name = "MetMashR_PathBank",
+    ...) {
     # new object
     out <- struct::new_struct(
         "PathBank_metabolite_database",
@@ -108,13 +107,13 @@ setMethod(
             )
         }
         obj$source <- db_url
-        
+
         # append version to rname
         obj$resource_name <- paste0(obj$resource_name, "_", obj$version)
-        
+
         # reuse BiocFileCache_database
         df <- callNextMethod(obj)
-        
+
         # return
         return(df)
     }

R/add_columns_class.R

@@ -3,18 +3,17 @@
 #' @include annotation_source_class.R
 #' @seealso [dplyr::left_join()]
 add_columns <- function(new_columns, by, ...) {
-    
-    if (nrow(new_columns)==0 & ncol(new_columns)==0) {
-        new_columns = data.frame(id=NA)
-        colnames(new_columns)[1]=by[1]
+    if (nrow(new_columns) == 0 & ncol(new_columns) == 0) {
+        new_columns <- data.frame(id = NA)
+        colnames(new_columns)[1] <- by[1]
     }
-    
+
     check <- all(by %in% colnames(new_columns))
     if (!check) {
         stop('parameter "by" must be a column name of the "new_columns",
             " data.frame')
     }
-    
+
     out <- struct::new_struct(
         "add_columns",
         new_columns = new_columns,

R/add_labels_class.R

@@ -69,7 +69,7 @@ add_labels <- function(labels, replace = FALSE, ...) {
 )
 
 setValidity("add_labels", method = function(object) {
-    check = FALSE
+    check <- FALSE
     if (length(object$labels) > 0) {
         check <- is.null(names(object$labels))
     }