fixes for BiocCheck

computational-metabolomics · Sep 13, 2024 · 8bab7ee · 8bab7ee
1 parent ab1d78e
commit 8bab7ee
Show file tree

Hide file tree

Showing 70 changed files with 1,020 additions and 920 deletions.
diff --git a/R/AnnotationDb_database.R b/R/AnnotationDb_database.R
@@ -3,9 +3,10 @@
 #' @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",

diff --git a/R/AnnotationDb_select_class.R b/R/AnnotationDb_select_class.R
@@ -3,12 +3,13 @@
 #' @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,
@@ -123,45 +124,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)
     }
 )
diff --git a/R/BiocFileCache_database_class.R b/R/BiocFileCache_database_class.R
@@ -2,13 +2,14 @@
 #' @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",
@@ -117,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)
     }
@@ -142,7 +143,7 @@ setMethod(
         query = obj$source,
         field = "fpath", exact = TRUE
     )$rid
-
+    
     # if not present, then add it
     if (!length(rid)) {
         rid <- names(
@@ -154,10 +155,11 @@ setMethod(
             )
         )
     }
-
-    if (rid %in% BiocFileCache::bfcquery(bfc,
-        field = "rtype", query = "web"
-    )$rid) {
+
+    if (rid %in% BiocFileCache::bfcquery(
+        bfc,
+        field = "rtype", 
+        query = "web")$rid) {
         # TRUE if newly added or stale
         update <- BiocFileCache::bfcneedsupdate(bfc, rid)
         if (is.na(update)) { # FALSE if NA
@@ -166,8 +168,8 @@ setMethod(
     } else {
         update <- FALSE # cant update if not web resource
     }
-
-
+    
+    
     # download & unzip
     if (update & !obj$offline) {
         BiocFileCache::bfcdownload(
@@ -178,9 +180,9 @@ setMethod(
             verbose = FALSE
         )
     }
-
+    
     # get path
     path <- BiocFileCache::bfcrpath(bfc, rids = rid)
-
+    
     return(path)
 }
diff --git a/R/CompoundDb_source_class.R b/R/CompoundDb_source_class.R
@@ -1,8 +1,9 @@
 #' @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,
@@ -33,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)
     }

diff --git a/R/MTox700plus_database_class.R b/R/MTox700plus_database_class.R
@@ -1,10 +1,11 @@
 #' @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",
@@ -102,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)
     }

diff --git a/R/PathBank_metabolite_database_class.R b/R/PathBank_metabolite_database_class.R
@@ -1,10 +1,11 @@
 #' @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",
@@ -106,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)
     }

diff --git a/R/annotation_bar_chart.R b/R/annotation_bar_chart.R
@@ -1,12 +1,13 @@
 #' @eval get_description('annotation_pie_chart')
 #' @include annotation_source_class.R
 #' @export
-annotation_bar_chart <- function(factor_name,
-                                 label_rotation = FALSE,
-                                 label_location = "inside",
-                                 label_type = "percent",
-                                 legend = FALSE,
-                                 ...) {
+annotation_bar_chart <- function(
+        factor_name,
+        label_rotation = FALSE,
+        label_location = "inside",
+        label_type = "percent",
+        legend = FALSE,
+        ...) {
     out <- struct::new_struct(
         "annotation_bar_chart",
         factor_name = factor_name,
@@ -16,7 +17,7 @@ annotation_bar_chart <- function(factor_name,
         legend = legend,
         ...
     )
-
+    
     return(out)
 }
 
@@ -111,7 +112,7 @@ setMethod(
             group_by(.data[[obj$factor_name]]) %>%
             summarise(count = n()) %>%
             tidyr::complete(.data[[obj$factor_name]], fill = list(count = 0))
-
+        
         # labels
         df$label <- ""
         if (obj$label_type == "percent") {
@@ -121,7 +122,7 @@ setMethod(
         } else if (obj$label_type == "count") {
             df$label <- as.character(df$count)
         }
-
+        
         if (obj$label_rotation) {
             df$label <- paste0(" ", df$label, " ")
         } else {
@@ -131,7 +132,7 @@ setMethod(
                 df$label <- paste0(df$label)
             }
         }
-
+        
         # add newlines of spaces to offset depending on rotation
         if (!obj$legend) {
             if (obj$label_type != "none") {
@@ -143,13 +144,13 @@ setMethod(
                 df$label <- df[[obj$factor_name]]
             }
         }
-
+        
         if (!obj$label_rotation) {
             df$rotate <- 0
         } else {
             df$rotate <- -90
         }
-
+        
         df$hjust <- 0.5
         if (obj$label_rotation) {
             if (obj$label_location == "inside") {
@@ -158,7 +159,7 @@ setMethod(
                 df$hjust <- 1
             }
         }
-
+        
         # plot
         g <- ggplot(
             data = df,
@@ -182,15 +183,15 @@ setMethod(
             structToolbox:::theme_Publication(12) +
             scale_fill_Publication() +
             theme_Publication()
-
+        
         # legend
         if (!obj$legend) {
             g <- g + theme(legend.position = "none")
         } else {
             g <- g + theme(axis.text.x = element_blank())
         }
-
-
+        
+        
         return(g)
     }
 )