rhdf5/tests/testthat/test_methods.R at dea4e882e96ceaa725cbad22ff2566a721f13737 · Huber-group-EMBL/rhdf5 · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
library(rhdf5)

############################################################
context("Print methods")
############################################################

h5File <- withr::local_tempfile(pattern = "H5_methods", fileext = ".h5")

test_that("Printing various object types", {
  ## file
  expect_silent(fid <- H5Fcreate(name = h5File))
  expect_output(print(fid), regexp = "HDF5 FILE")

  ## group
  expect_silent(gid <- H5Gcreate(fid, name = "foo"))
  expect_output(print(gid), regexp = "HDF5 GROUP")
  expect_silent(H5Gclose(gid))

  ## dataspace
  expect_silent(sid <- H5Screate_simple(dims = c(5, 5)))
  expect_output(print(sid), regexp = "HDF5 DATASPACE")

  ## dataset
  expect_silent(
    did <- H5Dcreate(
      h5loc = fid,
      name = "baa",
      dtype_id = "H5T_NATIVE_UINT32",
      h5space = sid
    )
  )
  expect_output(print(did), regexp = "HDF5 DATASET")

  ## datatype
  expect_silent(tid <- H5Tcopy("H5T_NATIVE_INT32"))
  expect_output(print(tid), regexp = "[0-9]{8}")

  ## attribute
  expect_silent(
    aid <- H5Acreate(did, name = "bang", dtype_id = tid, h5space = sid)
  )
  expect_output(print(aid), regexp = "HDF5 ATTR")

  ## close everything
  expect_silent(H5Aclose(aid))
  expect_silent(H5Sclose(sid))
  expect_silent(H5Dclose(did))
  expect_silent(H5Fclose(fid))
  expect_silent(H5Tclose(tid))
})

############################################################
context("Subsetting methods")
############################################################

h5File <- withr::local_tempfile(pattern = "H5_methods", fileext = ".h5")

test_that("Subsetting datasets", {
  A <- matrix(data = 1:200, nrow = 10)
  h5save(A, file = h5File)

  expect_silent(fid <- H5Fopen(name = h5File))
  expect_silent(did <- H5Dopen(h5loc = fid, name = "A"))

  expect_silent(col1 <- did[, 1])
  expect_is(col1, "integer")

  expect_silent(col15 <- did[, 1:5])
  expect_is(col15, "matrix")
  expect_identical(dim(col15), c(10L, 5L))

  # https://github.com/Huber-group-EMBL/rhdf5/issues/69
  myidx <- 1:5
  expect_no_condition(col15_fromvar <- did[, myidx])
  expect_identical(col15, col15_fromvar)

  expect_identical(did[], A)

  # https://github.com/Huber-group-EMBL/rhdf5/issues/68
  expect_no_condition(nodrop <- did[1, 1:5, drop = FALSE])
  expect_shape(nodrop, dim = c(1L, 5L))

  expect_silent(H5Dclose(did))

  expect_error(did[], regexp = "Bad HDF5 ID")
  expect_error(
    fid[, 3],
    regexp = "The provided H5Identifier is not a dataset identifier"
  )

  expect_silent(H5Fclose(fid))
})

test_that("Subsetting assignment", {
  expect_silent(fid <- H5Fopen(name = h5File))
  expect_silent(did <- H5Dopen(h5loc = fid, name = "A"))

  ## assign new values
  expect_silent(did[10, ] <- did[10, ] + 1000)
  expect_silent(did[, 1] <- 1001:1010)
  expect_silent(did[1:3, 5:7] <- rep(0, 9))
  # https://github.com/Huber-group-EMBL/rhdf5/issues/69
  ind <- 2
  expect_silent(did[ind, ind] <- 12L)
  ## in native R the 0 would be repeated to fill the space
  # expect_silent( did[1:3,5:7] <- 0 )

  ## close dataset and check the values are permanent
  expect_silent(H5Dclose(did))
  expect_silent(did <- H5Dopen(h5loc = fid, name = "A"))
  expect_identical(did[, 1], 1001:1010)
  expect_identical(did[10, ], seq(10L, 200L, 10L) + 1000L)
  expect_identical(did[1:3, 5:7], matrix(0L, ncol = 3, nrow = 3))
  expect_identical(did[2, 2], 12L)
  expect_silent(H5Dclose(did))

  expect_error(did[, 1] <- 10:1, regexp = "Bad HDF5 ID")
  expect_error(
    fid[, 3] <- 10,
    regexp = "The provided H5Identifier is not a dataset identifier"
  )

  expect_silent(H5Fclose(fid))
})