use return_object_or_list to return final object

R/GSEMatrix-helper.R

@@ -68,11 +68,7 @@ get_gse_matrix <- function(ids, dest_dir = getwd(), pdata_from_soft = TRUE, add_
             }
             do.call(Biobase::ExpressionSet, es_element)
         })
-        if (length(es_list) == 1L) {
-            es_list[[1L]]
-        } else {
-            es_list
-        }
+        return_object_or_list(es_list)
     })
 }
 

R/download_geo_files.R

@@ -13,10 +13,11 @@ download_geo_suppl_or_gse_matrix_files <- function(ids, dest_dir, file_type, pat
     }
     file_path_list <- lapply(url_list, function(urls) {
         # urls may be NULL or character(0L)
-        if (length(urls) == 0L) {
-            return(NULL)
+        if (length(urls)) {
+            file.path(dest_dir, basename(urls))
+        } else {
+            NULL
         }
-        file.path(dest_dir, basename(urls))
     })
     download_inform(
         unlist(url_list, recursive = FALSE, use.names = FALSE),
@@ -184,21 +185,20 @@ list_geo_file_url <- function(id, file_type, handle_opts = list(), ftp_over_http
         # use HTTPS to connect GEO FTP site
         # See https://github.com/seandavi/GEOquery/blob/master/R/getGEOSuppFiles.R
         xml_doc <- xml2::read_html(url_connection)
-        file_names <- xml2::xml_text(xml2::xml_find_all(
-            xml_doc, "//a/@href"
-        ))
+        file_names <- xml2::xml_text(xml2::xml_find_all(xml_doc, "//a/@href"))
     } else {
         file_names <- readLines(url_connection)
     }
     file_names <- grep("^G", file_names, perl = TRUE, value = TRUE)
+
     # build urls for all found files ------------------------
-    if (length(file_names) == 0L) {
+    if (length(file_names)) {
+        file_urls <- file.path(url, file_names)
+    } else {
         file_urls <- NULL
         cli::cli_alert_warning(
             "No {.field {file_type}} file found for {.val {id}}"
         )
-    } else {
-        file_urls <- file.path(url, file_names)
     }
     file_urls
 }
@@ -221,7 +221,7 @@ download_inform <- function(urls, file_paths, site, msg_id = "", handle_opts = l
         urls <- urls[!is_existed]
         file_paths <- file_paths[!is_existed]
     }
-    if (length(urls) > 0L) {
+    if (length(urls)) {
         cli::cli_inform(sprintf(
             "Downloading {.val {length(urls)}} %s file{?s} from %s", msg_id,
             switch(site,

R/get_geo.R

@@ -127,11 +127,5 @@ get_geo <- function(ids, dest_dir = getwd(), gse_matrix = TRUE, pdata_from_soft
             handle_opts = handle_opts
         )
     }
-
-    if (length(out_list) == 1L) {
-        out_list[[1L]]
-    } else {
-        names(out_list) <- ids
-        out_list
-    }
+    return_object_or_list(out_list, ids)
 }

R/get_geo_suppl.R

@@ -31,10 +31,5 @@ get_geo_suppl <- function(ids, dest_dir = getwd(), pattern = NULL, ftp_over_http
         ftp_over_https = ftp_over_https,
         handle_opts = handle_opts
     )
-    if (length(file_paths) == 1L) {
-        file_paths[[1L]]
-    } else {
-        names(file_paths) <- ids
-        file_paths
-    }
+    return_object_or_list(file_paths, ids)
 }

R/parsers.R

@@ -3,8 +3,7 @@
 parse_gse_matrix <- function(file_text, gse_sample_data = NULL) {
     # extract series matrix data
     matrix_data <- read_data_table(file_text)
-    data.table::setDF(matrix_data)
-    matrix_data <- as.matrix(column_to_rownames(matrix_data, 1L))
+    matrix_data <- as.matrix(matrix_data, names(matrix_data)[[1L]])
     meta_data <- parse_gse_matrix_meta(file_text)
 
     # fetch phenoData
@@ -207,8 +206,7 @@ parse_gds_soft <- function(file_text, only_meta = FALSE) {
         all.x = TRUE, sort = FALSE
     )
     column_data <- column_data[colnames(data_table), on = "V1"]
-    data.table::setDF(column_data)
-    column_data <- column_to_rownames(column_data, "V1")
+    column_data <- as.data.frame(column_data[, !1L], column_data$V1)
     list(
         data_table = data_table,
         meta = meta_data,

R/phenodata.R

@@ -218,7 +218,7 @@ parse_gse_soft_sample_characteristics <- function(gsm_list) {
         characteristics_cols[column_have_sep]
     ]
 
-    if (length(characteristics_cols) > 0L) {
+    if (length(characteristics_cols)) {
         any_more_than_one_seps <- sample_meta_dt[
             , vapply(.SD, function(list_col) {
                 # for a column with characteristics
@@ -295,7 +295,7 @@ parse_gse_soft_sample_characteristics <- function(gsm_list) {
 #' @noRd
 parse_name_value_pairs <- function(pair_list, sep = ":") {
     .characteristic_list <- lapply(pair_list, function(x) {
-        if (length(x) == 0L) {
+        if (!length(x)) {
             return(data.table::data.table())
         }
         # Don't use `data.table::tstrsplit`, as it will split string into three

R/show_geo.R

@@ -13,7 +13,7 @@
 #' @export
 show_geo <- function(id, browser = getOption("browser")) {
     if (!(length(id) == 1L && is.character(id))) {
-        stop("`id` must be a string", call. = FALSE)
+        cli::cli_abort("{.arg id} must be a string")
     }
     id <- toupper(id)
     check_ids(id)

R/utils.R

@@ -48,12 +48,13 @@ str_match <- function(string, pattern, ignore.case = FALSE) {
     out
 }
 
-# .data must be a data.frame
-# For data.table, we use setDF firstly
-column_to_rownames <- function(.data, var) {
-    rownames(.data) <- as.character(.data[[var]])
-    .data[[var]] <- NULL
-    .data
+return_object_or_list <- function(x, names = NULL) {
+    if (length(x) == 1L) {
+        x[[1L]]
+    } else {
+        if (!is.null(names)) names(x) <- names
+        x
+    }
 }
 
 read_lines <- function(file) {
@@ -90,7 +91,7 @@ read_lines <- function(file) {
 #' @param text A character vector
 #' @noRd
 read_text <- function(text, ...) {
-    if (length(text) == 0L) {
+    if (!length(text)) {
         return(data.table::data.table())
     }
     file <- tempfile()