More careful choice of HDF5 list NA placeholders for floats.

ArtifactDB · Oct 3, 2023 · 5e072f7 · 5e072f7
1 parent 32f7fba
commit 5e072f7
Show file tree

Hide file tree

Showing 2 changed files with 31 additions and 1 deletion.
diff --git a/R/stageBaseList.R b/R/stageBaseList.R
@@ -191,7 +191,14 @@ setMethod("stageObject", "list", function(x, dir, path, child=FALSE, fname="list
                         y[is.na(y)] <- placeholder
                     }
                 } else if (anyNA(y)) {
-                    placeholder <- as(NA, storage.mode(y))
+                    if (is.double(y)) {
+                        # Avoid unnecessary NA checks if they are all actually NaNs.
+                        if (sum(is.na(y)) > sum(is.nan(y))) {
+                            placeholder <- NA_real_
+                        }
+                    } else {
+                        placeholder <- as(NA, storage.mode(y))
+                    }
                 }
             } else {
                 if (is.logical(y) && anyNA(y)) {

diff --git a/tests/testthat/test-list.R b/tests/testthat/test-list.R
@@ -244,15 +244,38 @@ test_that("we handle lists with NAs", {
     old <- saveBaseListFormat("hdf5")
     on.exit(saveBaseListFormat(old))
 
+    tmp <- tempfile()
+    dir.create(tmp)
     info <- stageObject(vals, tmp, path="hstuff")
     resource <- writeMetadata(info, tmp)
     expect_match(info[["$schema"]], "hdf5_simple_list")
 
+    attrs <- rhdf5::h5readAttributes(file.path(tmp, "hstuff/list.h5"), "contents/data/1/data")
+    place <- attrs[["missing-value-placeholder"]]
+    expect_true(is.na(place) && !is.nan(place))
     attrs <- rhdf5::h5readAttributes(file.path(tmp, "hstuff/list.h5"), "contents/data/3/data")
     expect_identical(attrs[["missing-value-placeholder"]], "_NA")
 
     roundtrip <- loadBaseList(info, tmp)
     expect_identical(roundtrip, vals)
+
+    # Avoid unnecessary NA attributes for NaNs.
+    revals <- list(A=c(NaN, 1.0, 3, NaN), B=c(NaN, 1.0, NA, NaN))
+
+    tmp <- tempfile()
+    dir.create(tmp)
+    info <- stageObject(revals, tmp, path="hstuff2")
+    resource <- writeMetadata(info, tmp)
+
+    attrs <- rhdf5::h5readAttributes(file.path(tmp, "hstuff2/list.h5"), "contents/data/0/data")
+    place <- attrs[["missing-value-placeholder"]]
+    expect_null(place) # avoid saving an unnecessary placeholder.
+    attrs <- rhdf5::h5readAttributes(file.path(tmp, "hstuff2/list.h5"), "contents/data/1/data")
+    place <- attrs[["missing-value-placeholder"]]
+    expect_true(is.na(place) && !is.nan(place))
+
+    roundtrip <- loadBaseList(info, tmp)
+    expect_identical(roundtrip, revals)
 })
 
 test_that("we handle the various float specials", {