version 0.0.2

cran · Sep 22, 2023 · bc57d04 · bc57d04
1 parent c776d56
commit bc57d04
Show file tree

Hide file tree

Showing 13 changed files with 212 additions and 140 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: hdf5r.Extra
 Type: Package
 Title: Extensions for 'HDF5' R Interfaces
-Version: 0.0.1
-Date: 2023-08-26
+Version: 0.0.2
+Date: 2023-09-21
 Authors@R: person(given = "Yuchen", family = "Li", email = "ycli1995@outlook.com", role = c("aut", "cre"))
 Description: Some methods to manipulate 'HDF5' files, extending the 'hdf5r' package. Reading and writing R objects to 'HDF5' formats follow the specification of 'AnnData' <https://anndata.readthedocs.io/en/latest/fileformat-prose.html>.
 Depends: R (>= 4.1.0), hdf5r (>= 1.3.8), methods, utils
@@ -13,8 +13,8 @@ Encoding: UTF-8
 URL: https://github.com/ycli1995/hdf5r.Extra
 BugReports: https://github.com/ycli1995/hdf5r.Extra/issues
 NeedsCompilation: no
-Packaged: 2023-09-14 09:18:26 UTC; mydocker
+Packaged: 2023-09-22 05:07:50 UTC; mydocker
 Author: Yuchen Li [aut, cre]
 Maintainer: Yuchen Li <ycli1995@outlook.com>
 Repository: CRAN
-Date/Publication: 2023-09-14 10:30:02 UTC
+Date/Publication: 2023-09-22 07:30:02 UTC
diff --git a/MD5 b/MD5
@@ -1,33 +1,34 @@
-ce47ead77e00266b0a4c3b7dc0ec32a5 *DESCRIPTION
+092ba5a9d231d26ff9318433cb2a6a22 *DESCRIPTION
 1285b0f228eef791319304295b0184fc *LICENSE
 46afd66ee3b76c30a741a802b42432f8 *NAMESPACE
+8a70b484241314a464dc9a908c33d14f *NEWS.md
 5350e6ab1434ccd0a70dfa1562af2f8b *R/AllGenerics.R
-89e0ce6c6ae8b3f0af00ac991bf34ac2 *R/hdf5-functions.R
-7fc98eaecdc8713cc5a2fae956b039de *R/hdf5-internal.R
-9991fab2218486a7e8ec05f3c04e7f3d *R/hdf5-methods.R
+8bbd664ea2fa7923921b15716f4a0f26 *R/hdf5-functions.R
+f2b9c56104d1562ca1a4675b6e7fb968 *R/hdf5-internal.R
+0a7c3b98617a7270176c9337603aa092 *R/hdf5-methods.R
 c79087585c3cb97e93603e4637db4e6d *R/zzz.R
 d3f437597544eedce65892287c06d94b *README.md
 e28ff15653d6ad6c23682246a76fcd04 *inst/extdata/pbmc_small.h5ad
-20e3b4bc3211aa7cc503fbeed7950838 *man/H5-attributs.Rd
-985e039e065d3faf37a9e4f3210930d2 *man/H5-dataset-info.Rd
+3148c7d9176dc65616bee55654c3451e *man/H5-attributs.Rd
+3463e52b5f70b410cb148b854de4c130 *man/H5-dataset-info.Rd
 be8266f09349e8e3a2a843a179b4e213 *man/h5AbsLinkName.Rd
-bc6611114f9e10cfa812ba9dfcb027f4 *man/h5Backup.Rd
+4e8da2fb480dcb9b99bc18111d78eb8f *man/h5Backup.Rd
 4002d9bfe316fb247f5249b556b6fc22 *man/h5Class.Rd
-46fb67b1feee1894ac3da8115667904d *man/h5Copy.Rd
+f6d7ae7619c4c2c517ca7cdaa1a0b141 *man/h5Copy.Rd
 c07b22d0471d1a8c77d49c75eb9c4518 *man/h5CreateDataset.Rd
 725dec61c3df854ba353f79f12116060 *man/h5CreateFile.Rd
 b633edf99a57afe4ba05d9d70151e28f *man/h5CreateGroup.Rd
 44349caa9fe867e921b40b4cbe91d618 *man/h5Delete.Rd
 9f343c85c74d3a36e2a4f137b0ef69ca *man/h5Exists.Rd
 75cf2e18c63cdb17dad705b2bc408ed4 *man/h5GuessDtype.Rd
 088aa02bbd768597cdc645cb85ad17eb *man/h5List.Rd
-98510bee84829bec494c93b0dee6cb9b *man/h5Move.Rd
-eff9fb2f327337777c3c4b524ea43e08 *man/h5Open.Rd
+9f184f5b26861dba655d78f7e59fe0de *man/h5Move.Rd
+3faf6f1047eb373131a5c5d6b85c71c6 *man/h5Open.Rd
 d43a4069a214e44352f0d002d2285e50 *man/h5Overwrite.Rd
 4d76f73f11d9b95609dddac3717dbd7e *man/h5Prep.Rd
 73c480de6c10480475c89ec27c4b988a *man/h5Read.Rd
 c0052eb84def831ed64408f2c40576a7 *man/h5ReadDataset.Rd
-d2848f3d446825488b961dce40b9949c *man/h5TryOpen.Rd
+4fbea9b7744d9241d9fef19df2ffbc41 *man/h5TryOpen.Rd
 23d1d84660aea5b80a04f30d5c6147c0 *man/h5Write.Rd
 1419759fd274e9be57aa345e1c3b72bd *man/h5WriteDataset.Rd
 704982405edc6461bc1a605032687f9b *man/h5WriteScalar.Rd

diff --git a/NEWS.md b/NEWS.md
@@ -0,0 +1,11 @@
+# hdf5r.Extra 0.0.2
+## Bug fixes
+* Fixed bugs caused by `H5Backup` in old R release platform.
+* Fixed bugs caused by not using `tempfile` in examples.
+
+## Improvement
+* Add more formatted messages for verbose.
+
+# hdf5r.Extra 0.0.1
+
+* Initial release.
diff --git a/R/hdf5-functions.R b/R/hdf5-functions.R
@@ -81,8 +81,8 @@ h5GuessDtype <- function(x, stype = c('utf8', 'ascii7'), ...) {
 
 #' Automatically retry opening HDF5 file
 #' 
-#' Helper function to open HDF5 file. When the opening fails, will retry it util 
-#' reach a timeout.
+#' Helper function to open an HDF5 file. When the opening fails, will retry it 
+#' until reach a timeout.
 #' 
 #' @param filename An HDF5 file to open
 #' @param mode How to open it: 
@@ -235,17 +235,21 @@ is.H5Group <- function(file, name) {
 #' file <- system.file("extdata", "pbmc_small.h5ad", package = "hdf5r.Extra")
 #' to.file <- tempfile(fileext = ".h5")
 #' 
+#' # Copy a link to a new file
 #' h5Copy(file, "obs", to.file, "obs")
-#' 
 #' obs <- h5Read(file, "obs")
 #' obs2 <- h5Read(to.file, "obs")
-#' 
 #' stopifnot(identical(obs, obs2))
 #' 
+#' # The parent link (H5Group) will be created automatically
 #' h5Copy(file, "obsm/tsne", to.file, "obsm/tsne")
 #' obsm <- h5Read(to.file, "obsm")
 #' 
-#' h5Copy(file, "/", to.file, "/")
+#' # Copy the whole file
+#' x <- h5Read(file)
+#' h5Copy(file, "/", to.file, "/", overwrite = TRUE)
+#' x2 <- h5Read(to.file)
+#' stopifnot(identical(x, x2))
 #' 
 #' @export
 h5Copy <- function(
@@ -261,6 +265,15 @@ h5Copy <- function(
   from.name <- h5AbsLinkName(name = from.name)
   to.file <- normalizePath(path = to.file, mustWork = FALSE)
   to.name <- h5AbsLinkName(name = to.name)
+  if (verbose) {
+    message(
+      "h5Copy: ",
+      "\n  Source file: ", from.file,
+      "\n  Destination file: ", to.file,
+      "\n  Source name: ", from.name,
+      "\n  Destination name: ", to.name
+    )
+  }
   if (identical(x = from.file, y = to.file)) {
     return(.h5copy_same_file(
       h5.file = from.file, 
@@ -310,7 +323,12 @@ h5Copy <- function(
 #' obs2 <- h5Read(to.file, "obs2")
 #' stopifnot(identical(obs, obs2))
 #' 
-#' h5Move(to.file, "obs", "var")
+#' # Move an object to an existing link
+#' h5Move(to.file, "obs2", "var")  # Warning
+#' h5Move(to.file, "obs2", "var", overwrite = TRUE)
+#' 
+#' # Move a non-existing object will raise an error
+#' try(h5Move(to.file, "obs", "obs3"))
 #' 
 #' @export
 h5Move <- function(
@@ -323,6 +341,14 @@ h5Move <- function(
 ) {
   from.name <- h5AbsLinkName(name = from.name)
   to.name <- h5AbsLinkName(name = to.name)
+  if (verbose) {
+    message(
+      "h5Move: ",
+      "\n  File: ", file,
+      "\n  Source name: ", from.name,
+      "\n  Destination name: ", to.name
+    )
+  }
   if (identical(x = from.name, y = to.name)) {
     warning(
       "The source name and the destination name are identical.",
@@ -332,23 +358,23 @@ h5Move <- function(
   }
   h5fh <- h5TryOpen(filename = file, mode = "r+")
   on.exit(expr = h5fh$close())
+  if (!h5Exists(x = h5fh, name = from.name)) {
+    stop("Cannot move a non-existing object: ", from.name)
+  }
   if (h5Exists(x = h5fh, name = to.name)) {
     if (!overwrite) {
       warning(
-        "'", to.name, "' already exists in file '", file, "'.\n", 
-        "You need to set 'overwrite' to TRUE",
+        "Destination object already exists. ",
+        "Set 'overwrite = TRUE' to remove it.",
         immediate. = TRUE
       )
       return(invisible(x = NULL))
     }
     if (verbose) {
-      message("Delete the existing '", to.name, "'")
+      message("Destination object already exists, removing it.")
     }
     h5fh$link_delete(name = to.name)
   }
-  if (verbose) {
-    message("Move '", from.name, "' to '", to.name, "' in file '", file, "'")
-  }
   h5CreateGroup(
     x = h5fh, 
     name = dirname(path = to.name), 
@@ -389,9 +415,10 @@ h5Move <- function(
 #' 
 #' h5Backup(file, to.file, exclude = "X")
 #' 
-#' obs <- h5Read(file, "obs")
-#' obs2 <- h5Read(to.file, "obs")
-#' stopifnot(identical(obs, obs2))
+#' x <- h5Read(file)
+#' x2 <- h5Read(to.file)
+#' x$X <- NULL # Remove 'X'
+#' stopifnot(identical(x, x2)) # Now these two should be identical
 #' 
 #' @export
 h5Backup <- function(
@@ -405,14 +432,19 @@ h5Backup <- function(
   to.file <- to.file %||% paste0(tempfile(), ".h5")
   to.file <- normalizePath(path = to.file, mustWork = FALSE)
   from.file <- file_path_as_absolute(x = from.file)
+  if (verbose) {
+    message(
+      "h5Backup: ",
+      "\n  Source file: ", from.file,
+      "\n  Destination file: ", to.file,
+      "\n  Excluded objects: ", paste(exclude, collapse = ", ")
+    )
+  }
   if (identical(x = from.file, y = to.file)) {
-    stop("The source file and the target file are identical.")
+    stop("\n  The source file and the target file are identical.")
   }
   if (!overwrite && file.exists(to.file)) {
-    stop(
-      "The target file '", to.file, "' exists, ", 
-      "please set 'overwrite = TRUE'"
-    )
+    stop("The destination file exists, please set 'overwrite = TRUE'")
   }
   h5fh <- h5TryOpen(filename = from.file, mode = "r")
   all_links <- h5List(
@@ -438,14 +470,10 @@ h5Backup <- function(
   on.exit(expr = to.h5fh$close(), add = TRUE)
   for (i in seq_along(along.with = all_links$name)) {
     if (verbose) {
-      message(
-        "Backup '", all_links[i, "name"], "' from '", from.file, "' to ", 
-        "'", to.file, "'"
-      )
+      message("Backup '", all_links[i, "name"], "'")
     }
-    check.create_group <- all_links[i, "obj_type"] %in% "H5I_GROUP" && 
-      !h5Exists(x = to.h5fh, name = all_links[i, "name"])
-    if (check.create_group) {
+    # all_links[i, "obj_type"] is actually `factor_ext`
+    if (as.character(x = all_links[i, "obj_type"]) %in% "H5I_GROUP") {
       h5CreateGroup(
         x = to.h5fh, 
         name = all_links[i, "name"], 
@@ -526,7 +554,7 @@ h5Overwrite <- function(file, name, overwrite) {
   file <- normalizePath(path = file)
   if (name == "/" & overwrite) {
     warning(
-      "Overwrite '/' for existing file '", file, "' will create an empty file.", 
+      "Overwrite '/' will truncate anything in the orignial file:\n  ", file,
       immediate. = TRUE
     )
     h5fh <- h5TryOpen(filename = file, mode = "w")
@@ -538,12 +566,18 @@ h5Overwrite <- function(file, name, overwrite) {
   }
   if (!overwrite) {
     stop(
-      "'", name, "' exists in file ", file, ". ",
-      "Please set 'overwrite = TRUE' to delete it."
+      "\nFound object that already exists: ",
+      "\n  File: ", file, 
+      "\n  Object: ", name,
+      "\nSet 'overwrite = TRUE' to remove it."
     )
   }
   tmp.file <- tempfile(tmpdir = dirname(path = file), fileext = ".h5")
-  message("Try to overwrite '", name, "' in file '", file, "'")
+  message(
+    "Overwriting existing H5 object:",
+    "\n  File: ", file,
+    "\n  Object: ", name
+  )
   file.rename(from = file, to = tmp.file)
   tryCatch(
     expr = {