Merge pull request #102 from stemangiola/fix-60-v2

Download size reporting

Author: stemangiola

NAMESPACE

@@ -30,18 +30,17 @@ importFrom(dbplyr,remote_con)
 importFrom(dplyr,as_tibble)
 importFrom(dplyr,collect)
 importFrom(dplyr,filter)
-importFrom(dplyr,full_join)
 importFrom(dplyr,group_by)
 importFrom(dplyr,inner_join)
 importFrom(dplyr,mutate)
 importFrom(dplyr,pull)
 importFrom(dplyr,summarise)
 importFrom(dplyr,tbl)
-importFrom(dplyr,tibble)
 importFrom(dplyr,transmute)
 importFrom(duckdb,duckdb)
 importFrom(glue,glue)
 importFrom(httr,GET)
+importFrom(httr,HEAD)
 importFrom(httr,modify_url)
 importFrom(httr,parse_url)
 importFrom(httr,progress)
@@ -51,11 +50,12 @@ importFrom(methods,as)
 importFrom(purrr,imap)
 importFrom(purrr,keep)
 importFrom(purrr,map)
+importFrom(purrr,map_chr)
+importFrom(purrr,map_dbl)
 importFrom(purrr,map_int)
 importFrom(purrr,pmap_chr)
 importFrom(purrr,reduce)
 importFrom(purrr,set_names)
-importFrom(purrr,transpose)
 importFrom(purrr,walk)
 importFrom(rlang,.data)
 importFrom(stats,setNames)

R/metadata.R

@@ -101,6 +101,7 @@ get_metadata <- function(
         cached_connection
     }
     else {
+        report_file_sizes(remote_url)
         db_path <- file.path(cache_directory, "metadata.0.2.3.parquet")
         sync_remote_file(
             remote_url,

R/query.R

@@ -148,7 +148,6 @@ get_SingleCellExperiment <- function(
 }
 
 #' Converts a data frame into a single SCE
-#'
 #' @param i Suffix to be added to the column names, to make them unique
 #' @param df The data frame to be converted
 #' @param dir_prefix The path to the single cell experiment, minus the final segment
@@ -216,7 +215,6 @@ group_to_sce <- function(i, df, dir_prefix, features) {
 }
 
 #' Synchronises one or more remote assays with a local copy
-#'
 #' @param url A character vector of length one. The base HTTP URL from which to
 #'   obtain the files.
 #' @param cache_dir A character vector of length one. The local filepath to
@@ -226,14 +224,10 @@ group_to_sce <- function(i, df, dir_prefix, features) {
 #' @param files A character vector containing one or more file_id_db entries
 #' @returns A character vector consisting of file paths to all the newly
 #'   downloaded files
-#'
 #' @return A character vector of files that have been downloaded
-#' @importFrom purrr pmap_chr transpose
-#' @importFrom httr modify_url GET write_disk stop_for_status parse_url
-#' @importFrom dplyr tibble transmute filter full_join
-#' @importFrom glue glue
-#' @importFrom assertthat assert_that
-#' @importFrom cli cli_alert_success cli_alert_info cli_abort
+#' @importFrom purrr pmap_chr map_chr
+#' @importFrom httr modify_url
+#' @importFrom dplyr transmute filter
 #' @noRd
 #'
 sync_assay_files <- function(
@@ -244,7 +238,7 @@ sync_assay_files <- function(
 ) {
     # Find every combination of file name, sample id, and assay, since each
     # will be a separate file we need to download
-    expand.grid(
+    files = expand.grid(
         filename = c("assays.h5", "se.rds"),
         sample_id = files,
         subdir = subdirs,
@@ -261,7 +255,7 @@ sync_assay_files <- function(
                 .data$sample_id,
                 "/",
                 .data$filename
-            ) |> map(~ modify_url(url, path = .)),
+            ) |> map_chr(~ modify_url(url, path = .)),
 
             # Path to save the file on local disk (and its parent directory)
             # We use file.path since the file separator will differ on other OSs
@@ -281,14 +275,19 @@ sync_assay_files <- function(
             # proceed with the download if it has. However this is low
             # importance as the repository is not likely to change often
             !file.exists(.data$output_file)
-        ) |>
-        pmap_chr(function(full_url, output_dir, output_file) {
-            sync_remote_file(full_url, output_file)
-            output_file
-        }, .progress = list(name = "Downloading files"))
+        )
+    
+    report_file_sizes(files$full_url)
+    
+    pmap_chr(files, function(full_url, output_dir, output_file) {
+        sync_remote_file(full_url, output_file)
+        output_file
+    }, .progress = list(name = "Downloading files"))
 }
 
 #' Synchronises a single remote file with a local path
+#' @importFrom httr write_disk GET stop_for_status
+#' @importFrom cli cli_abort cli_alert_info
 #' @noRd
 sync_remote_file <- function(full_url, output_file, ...) {
     if (!file.exists(output_file)) {

R/unharmonised.R

@@ -67,7 +67,7 @@ get_unharmonised_dataset = function(
 #' harmonised <- get_metadata() |> dplyr::filter(tissue == "kidney blood vessel")
 #' unharmonised <- get_unharmonised_metadata(harmonised)
 get_unharmonised_metadata = function(metadata, ...){
-    args = list(...)
+    args <- list(...)
     metadata |>
         collect() |>
         group_by(.data$file_id) |>

R/utils.R

@@ -0,0 +1,26 @@
+#' Gets the file size of a number of remote files
+#' @param urls A character vector containing URLs
+#' @return The file size of each of the files pointed to by the provided URL,
+#' in gigabytes, as double vector
+#' @importFrom purrr map_dbl
+#' @importFrom httr HEAD
+#' @keywords internal
+url_file_size = function(urls){
+    map_dbl(urls, function(url){
+        as.integer(
+            HEAD(url)$headers$`content-length` 
+        ) / 10^9
+    })
+}
+
+#' Prints a message indicating the size of a download
+#' @inheritParams url_file_size
+#' @importFrom cli cli_alert_info
+#' @keywords internal
+report_file_sizes = function(urls){
+    total_size = url_file_size(urls) |> 
+        sum() |>
+        round(digits=2)
+    
+    cli_alert_info("Downloading {length(urls)} file{?s}, totalling {total_size} GB")
+}

R/zzz.R

@@ -0,0 +1,14 @@
+#' @importFrom purrr walk
+#' @importFrom dbplyr remote_con
+#' @importFrom DBI dbDisconnect
+.onUnload = function(libname, pkgname){
+    # Close connections to all cached tables. This should avoid most of the
+    # "Connection is garbage-collected" messages
+    cache$metadata_table |>
+        as.list() |>
+        walk(function(table){
+            table |>
+                remote_con() |>
+                dbDisconnect()
+        })
+}

README.Rmd

@@ -28,7 +28,7 @@ knitr::include_graphics(c(
   "man/figures/svcf_logo.jpeg", 
   "man/figures/czi_logo.png", 
   "man/figures/bioconductor_logo.jpg",
-    "man/figures/vca_logo.png",
+  "man/figures/vca_logo.png",
   "man/figures/nectar_logo.png"
 ))
 ```
@@ -54,7 +54,7 @@ library(CuratedAtlasQueryR)
 ### Load the metadata
 
 ```{r}
-metadata  = get_metadata()
+metadata = get_metadata()
 
 metadata
 ```

tests/testthat/test-utils.R

@@ -0,0 +1,11 @@
+test_that("url_file_size() returns the correct sizes", {
+    c(
+        "https://ftp.ncbi.nlm.nih.gov/refseq/H_sapiens/annotation/GRCh38_latest/refseq_identifiers/GRCh38_latest_genomic.fna.gz",
+        "https://ftp.ncbi.nlm.nih.gov/refseq/H_sapiens/annotation/GRCh37_latest/refseq_identifiers/GRCh37_latest_genomic.fna.gz"
+    ) |>
+        url_file_size() |>
+        expect_equal(c(
+            0.973,
+            0.944
+        ), tolerance = 0.001)
+})

vignettes/Introduction.Rmd

@@ -31,7 +31,7 @@ knitr::include_graphics(c(
   "../man/figures/svcf_logo.jpeg", 
   "../man/figures/czi_logo.png", 
   "../man/figures/bioconductor_logo.jpg",
-    "../man/figures/vca_logo.png",
+  "../man/figures/vca_logo.png",
   "../man/figures/nectar_logo.png"
 ))
 ```
@@ -92,7 +92,6 @@ metadata |>
 ### Query raw counts
 
 ```{r}
-
 single_cell_counts = 
 	metadata |>
     dplyr::filter(