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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
|
#############################################################################
##
## Copyright 2016 Novartis Institutes for BioMedical Research Inc.
## Licensed under the Apache License, Version 2.0 (the "License");
## you may not use this file except in compliance with the License.
## You may obtain a copy of the License at
##
## http://www.apache.org/licenses/LICENSE-2.0
##
## Unless required by applicable law or agreed to in writing, software
## distributed under the License is distributed on an "AS IS" BASIS,
## WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
## See the License for the specific language governing permissions and
## limitations under the License.
##
#############################################################################
##' Class for representing HDF5 attributes
##'
##' This class represents an HDF5 attribute. Usually it is easier to read and write attributes for
##' groups, datasets and committed datatypes using the functions documented in \code{\link{h5attributes}}.
##'
##' Otherwise, the functionality for attributes is very similar to that of datasets (\code{\link{H5D}}),
##' however with the notable exception that attributes always have to be read and written as a whole.
##'
##' @docType class
##' @importFrom R6 R6Class
##' @return Object of class \code{\link{H5A}}.
##' @author Holger Hoefling
##' @examples
##' fname <- tempfile(fileext = ".h5")
##' file <- H5File$new(fname, mode = "a")
##' h5attr(file, "attr_numeric") <- rnorm(10)
##' a <- file$attr_open("attr_numeric")
##' a$get_info()
##' a$attr_name()
##' a$get_space()
##' a$get_type()
##' a$get_storage_size()
##' a$read()
##' a$write(10:1)
##' a$print()
##' a$close()
##' file$close_all()
##' @export
H5A <- R6Class("H5A",
inherit=H5RefClass,
public=list(
get_info=function() {
"This function implements the HDF5-API function H5Aget_info."
"Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_GET_INFO} for details."
res <- .Call("R_H5Aget_info", self$id, request_empty(1), PACKAGE="hdf5r")
if(res$return_val < 0) {
stop("Error retrieving attribute info")
}
return(res$ainfo)
},
attr_name=function() {
"This function implements the HDF5-API function H5Aget_name."
"Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_GET_NAME} for details."
## get size of the name
name_size <- .Call("R_H5Aget_name", self$id, 0, character(0), PACKAGE="hdf5r")$return_val
if(name_size < 0) {
stop("Error returning name of object")
}
if(name_size == 0) {
return(NA)
}
## create a character vector of sufficient size (it will be copied in the internal C function as is available for writign
char_buf=paste(rep(" ", name_size+1), collapse="")
res <- .Call("R_H5Aget_name", self$id, name_size + 1, char_buf, PACKAGE="hdf5r")
if(res$return_val < 0) {
stop("Error returning name of object")
}
return(res$buf)
},
get_space=function() {
"This function implements the HDF5-API function H5Aget_space."
"Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_GET_SPACE} for details."
id <- .Call("R_H5Aget_space", self$id, PACKAGE="hdf5r")$return_val
if(id < 0) {
stop("Error retrieving attribute type")
}
return(H5S$new(id=id))
},
get_type=function(native=TRUE) {
"This function implements the HDF5-API function H5Aget_type."
"Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_GET_TYPE} for details."
id <- .Call("R_H5Aget_type", self$id, PACKAGE="hdf5r")$return_val
if(id < 0) {
stop("Error retrieving attribute type")
}
if(native) {
on.exit(.Call("R_H5Tclose", id, PACKAGE="hdf5r"))
## return the native type
id_native <- .Call("R_H5Tget_native_type", id, h5const$H5T_DIR_ASCEND, PACKAGE="hdf5r")$return_val
if(id_native < 0) {
stop("Error retrieving native-c-type")
}
return(H5T_factory(id_native))
}
else {
return(H5T_factory(id))
}
},
get_storage_size=function() {
"This function implements the HDF5-API function H5Aget_storage_size."
"Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_GET_STORAGE_SIZE} for details."
size <- .Call("R_H5Aget_storage_size", self$id, PACKAGE="hdf5r")$return_val
return(size)
},
read_low_level=function(buffer, mem_type, duplicate_buffer=FALSE) {
"Only for advanced users. See documentation for \\code{read} instead."
"This function implements the HDF5-API function H5Aread."
"Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_READ} for details."
check_class(mem_type, "H5T")
res <- .Call("R_H5Aread", self$id, mem_type$id, buffer, duplicate_buffer, PACKAGE="hdf5r")
if(res$return_val < 0) {
stop("Error reading dataset")
}
return(res$buffer)
},
read=function(flags=getOption("hdf5r.h5tor_default"), drop=TRUE) {
"Reads the data of the attribute and returns it as an R-object"
"@param flags Conversion rules for integer values. See also \\code{\\link{h5const}}"
"@param drop Logical. Should dimensions of length 1 be dropped (R-default for arrays)"
mem_type <- self$get_type()
check_class(mem_type, "H5T")
## get the actual file-space and ascertain its size
attr_space <- self$get_space()
attr_space_type <- as.character(attr_space$get_simple_extent_type())
if(attr_space_type == "H5S_NULL" ) {
nelem <- 0
}
else if(attr_space_type=="H5S_SCALAR") {
nelem <- 1
}
else {
nelem <- attr_space$get_select_npoints()
}
## need to create the buffer to write this into
buffer <- H5ToR_Pre(mem_type, nelem)
res <- .Call("R_H5Aread", self$id, mem_type$id, buffer, FALSE, PACKAGE="hdf5r")
if(res$return_val < 0) {
stop("Error reading dataset")
}
buffer_post <- H5ToR_Post(res$buf, mem_type, nelem, flags, self$id)
## reclaim vlen data; always do this, to make sure
## there is no native reclaim function for attributes; use the H5D function for now
if(mem_type$is_vlen()) {
herr <- .Call("R_H5Dvlen_reclaim", mem_type$id, attr_space$id, h5const$H5P_DEFAULT$id, res$buf, FALSE,
PACKAGE="hdf5r")$return_val
if(herr < 0 ) {
stop("Error trying to reclaim buffer vlen data")
}
}
## apply the right dimension, if it is available
dim_to_set <- extract_dim(space=attr_space, dtype=mem_type)
if(drop) {
dim_to_set <- dim_to_set[dim_to_set != 1]
}
if(length(dim_to_set) > 1) {
.Call("set_dim_attribute", buffer_post, as.numeric(dim_to_set), PACKAGE = "hdf5r")
}
return(buffer_post)
},
write_low_level=function(buffer, mem_type) {
"Only for advanced users. See documentation for \\code{write} instead."
"This function implements the HDF5-API function H5Awrite."
"Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_WRITE} for details."
check_class(mem_type, "H5T")
res <- .Call("R_H5Awrite", self$id, mem_type$id, buffer, PACKAGE="hdf5r")
if(res$return_val < 0) {
stop("Error reading dataset")
}
return(invisible(self))
},
write=function(robj, mem_type=NULL, flush=getOption("hdf5r.flush_on_write")) {
"Writes the data of \\code{robj} to the attribute"
"@param robj The object to write into the attribute"
"@param mem_type The memory data type to use when transferring from HDF5 to intermediate storage. This is an "
"advanced development feature and may be removed in the future."
if(is.null(mem_type)) {
mem_type <- self$get_type()
}
## get the actual file-space and ascertain its size
attr_space <- self$get_space()
attr_space_type <- as.character(attr_space$get_simple_extent_type())
if(attr_space_type == "H5S_NULL" ) {
nelem_file <- 0
}
else if(attr_space_type=="H5S_SCALAR") {
nelem_file <- 1
}
else {
nelem_file <- attr_space$get_select_npoints()
}
nelem_robj <- guess_nelem(robj, mem_type)
if(nelem_robj != nelem_file) {
stop("Number of objects in robj does not match number of elements selected in file")
}
buffer <- RToH5(robj, mem_type, nelem_robj)
res <- .Call("R_H5Awrite", self$id, mem_type$id, buffer, PACKAGE="hdf5r")
if(res$return_val < 0) {
stop("Error writing dataset")
}
if(flush) {
self$flush()
}
return(invisible(self))
},
print=function(...){
"Prints information for the dataset"
"@param ... ignored"
is_valid <- self$is_valid
print_class_id(self, is_valid)
if(is_valid) {
## get information about the file
## get the dataset name
cat("Attribute: ", self$attr_name(), "\n", sep="")
this_dtype <- self$get_type()
type_text <- this_dtype$to_text()
cat("Datatype: ", type_text, "\n", sep="")
this_dtype$close()
## get the dataspace
this_space <- self$get_space()
if(!this_space$is_simple()) {
## has to be a NULL space
cat("Space: Type=NULL\n")
}
else {
extent_res <- this_space$get_simple_extent_dims()
if(extent_res$rank == 0) {
cat("Space: Type=Scalar\n")
}
else {
cat("Space: Type=Simple ")
cat("Dims=", paste(extent_res$dims, collapse=" x "), " ", sep="")
cat("Maxdims=", paste(extent_res$maxdims, collapse=" x "), "\n", sep="")
}
}
this_space$close()
}
}
),
private=list(
closeFun=function(id) if(!is.na(id) && is.loaded("R_H5Aclose", PACKAGE="hdf5r")) {
invisible(.Call("R_H5Aclose", id, PACKAGE = "hdf5r"))}
),
cloneable=FALSE
)
R6_set_list_of_items(H5A, "public", commonFGDTA, overwrite=TRUE)
|
