R/Common_functions.R

#############################################################################
##
## 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.
##
#############################################################################





interface <- list(
    get_file_id=function() {
        "This function implements the HDF5-API function H5Iget_file_id."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5I_GET_FILE_ID} for details."

        fid <- .Call("R_H5Iget_file_id", self$id, PACKAGE="hdf5r")$return_val
        return(H5File$new(id=fid))
    },
    get_obj_type=function() {
        "This function implements the HDF5-API function H5Iget_type."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5I_GET_TYPE} for details."

        res <- .Call("R_H5Iget_type", self$id, PACKAGE="hdf5r")$return_val
        return(res)
    },
    get_ref=function() {
        "This function implements the HDF5-API function H5Iget_ref."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5I_GET_REF} for details."

        res <- .Call("R_H5Iget_ref", self$id, PACKAGE="hdf5r")$return_val
        if(res < 0) {
            stop("Error retrieving refernce count")
        }
        return(res)
    },
    inc_ref=function() {
        "This function implements the HDF5-API function H5Iinc_ref."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5I_INC_REF} for details."

        res <- .Call("R_H5Iinc_ref", self$id, PACKAGE="hdf5r")$return_val
        if(res < 0) {
            stop("Error retrieving refernce count")
        }
        return(invisible(self))
    },
    dec_ref=function() {
        "This function implements the HDF5-API function H5Idec_ref."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5I_DEC_REF} for details."

        res <- .Call("R_H5Idec_ref", self$id, PACKAGE="hdf5r")$return_val
        if(res < 0) {
            stop("Error retrieving refernce count")
        }
        return(invisible(self))
    }
    )

commonFG <- list(
    open=function(name, link_access_pl=h5const$H5P_DEFAULT, dataset_access_pl=h5const$H5P_DEFAULT, type_access_pl=h5const$H5P_DEFAULT) {
        "Opens groups, datasets or types using the appropriate HDF5-API functions. Please see the documentation at"
        "\\url{https://portal.hdfgroup.org/display/HDF5/H5D_OPEN} for datasets, "
        "\\url{https://portal.hdfgroup.org/display/HDF5/H5O_OPEN} for types and "
        "\\url{https://portal.hdfgroup.org/display/HDF5/H5O_OPEN} for general objects."

        if (length(name)!=1 || !is.character(name)) stop("'name' must be a character string of length 1")

        ## check the property lists and get their ids if they aren't already default
        check_pl(link_access_pl, "H5P_LINK_ACCESS")
        check_pl(dataset_access_pl, "H5P_DATASET_ACCESS")
        check_pl(type_access_pl, "H5P_TYPE_ACCESS")

        if(self$exists(name, link_access_pl=link_access_pl)) {
            ## check if any of the other properties are set; if yes - use them
            if(dataset_access_pl$id != h5const$H5P_DEFAULT$id) {
                ## use specialized method as it seems to be a dataset
                oid <- .Call("R_H5Dopen", self$id, name, dataset_access_pl$id, PACKAGE = "hdf5r")$return_val
            }
            else if(type_access_pl$id != h5const$H5P_DEFAULT$id) {
                oid <- .Call("R_H5Topen2", self$id, name, type_access_pl$id, PACKAGE = "hdf5r")$return_val
            }
            else {
                oid <- .Call("R_H5Oopen", self$id, name, link_access_pl$id, PACKAGE = "hdf5r")$return_val
            }
            if(oid < 0) {
                stop("Error opening object")
            }
            return(H5GTD_factory(oid))
        }
        else {
            stop(paste("An object with name", name, "does not exist"))
        }
    },
    open_by_idx=function(n, group_name=".", index_type=h5const$H5_INDEX_NAME, order=h5const$H5_ITER_NATIVE, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Oopen_by_idx."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5O_OPEN_BY_IDX} for details."

        if (length(group_name)!=1 || !is.character(group_name)) stop("'group_name' must be a character string of length 1")

        ## check the property lists and get their ids if they aren't already default
        check_pl(link_access_pl, "H5P_LINK_ACCESS")

        if(group_name=="." || self$exists(group_name, link_access_pl=link_access_pl)) {
            ## check if any of the other properties are set; if yes - use them
            oid <- .Call("R_H5Oopen_by_idx", self$id, group_name, index_type, order, n, link_access_pl$id, PACKAGE = "hdf5r")$return_val
            if(oid < 0) {
                stop("Error opening object")
            }
            return(H5GTD_factory(oid))
        }
        else {
            stop(paste("An object with name", group_name, "does not exist"))
        }
    },
    ls=function(recursive=FALSE, detailed=FALSE, index_type=h5const$H5_INDEX_NAME, order=h5const$H5_ITER_NATIVE, link_access_pl=h5const$H5P_DEFAULT,
        dataset_access_pl=h5const$H5P_DEFAULT, type_access_pl=h5const$H5P_DEFAULT) {
        "Returns the contents of a file or group as a data.frame."

        ls_res <- .Call("R_H5ls", self$id, recursive, index_type, order, link_access_pl$id,
                        dataset_access_pl$id, type_access_pl$id, PACKAGE='hdf5r')$return_val
        ls_res <- clean_ls_df(ls_res)
        if(detailed) {
            return(ls_res)
        }
        else {
            ls_res <- flatten_df(ls_res)
            ls_res_summary <- ls_res[, c("name", "link.type", "obj_type", "num_attrs", "group.nlinks", "group.mounted", "dataset.rank",
                                         "dataset.dims", "dataset.maxdims", "dataset.type_class", "dataset.space_class", "committed_type")]
            return(ls_res_summary)
        }
    },
    exists=function(name, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Lexists."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5L_EXISTS} for details."

        check_pl(link_access_pl, "H5P_LINK_ACCESS")
        res <- .Call("R_H5Lexists", self$id, name, link_access_pl$id, PACKAGE = "hdf5r")$return_val
        if(res < 0) {
            stop("Error trying to ascertain if link exists")
        }
        return(res > 0)
    },
    path_valid=function(path, check_object_valid=TRUE) {
        "This function implements the HDF5-API function H5LTpath_valid."
        "Please see the documentation at \\url{https://support.hdfgroup.org/HDF5/doc/HL/RM_H5LT.html#H5LTpath_valid} for details."

        res <- .Call("R_H5LTpath_valid", self$id, path, check_object_valid, PACKAGE = "hdf5r")$return_val
        if(res < 0) {
            stop("Error trying to ascertain if path is valid")
        }
        return(res > 0)
    },
    link=function(obj, new_link_name, link_create_pl=h5const$H5P_DEFAULT, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Olink."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5O_LINK} for details."

        if(!(inherits(obj, "H5D") || inherits(obj, "H5Group") || inherits(obj, "H5T"))) {
            stop("obj has to be a group, dataset or type")
        }

        check_pl(link_access_pl, "H5P_LINK_ACCESS")
        check_pl(link_create_pl, "H5P_LINK_CREATE")
        herr <- .Call("R_H5Olink", obj$id, self$id, new_link_name, link_create_pl$id, link_access_pl$id, PACKAGE = "hdf5r")$return_val
        if(herr < 0) {
            stop("Error trying to create a new link")
        }
        return(invisible(self))
    },
    obj_copy_to=function(dst_loc, dst_name, src_name, object_copy_pl=h5const$H5P_DEFAULT, link_create_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Ocopy."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5O_COPY} for details."

        if(!(inherits(dst_loc, "H5File") || inherits(dst_loc, "H5Group"))) {
            stop("dst_loc has to be a file or group")
        }
        check_pl(link_create_pl, "H5P_LINK_CREATE")
        check_pl(object_copy_pl, "H5P_OBJECT_COPY")

        herr <- .Call("R_H5Ocopy", self$id, src_name, dst_loc$id, dst_name, object_copy_pl$id, link_create_pl$id, PACKAGE = "hdf5r")$return_val
        if(herr < 0) {
            stop("Error copying object")
        }
        return(invisible(self))
    },
    obj_copy_from=function(src_loc, src_name, dst_name, object_copy_pl=h5const$H5P_DEFAULT, link_create_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Ocopy."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5O_COPY} for details."

        if(!(inherits(src_loc, "H5File") || inherits(src_loc, "H5Group"))) {
            stop("src_loc has to be a file or group")
        }
        check_pl(link_create_pl, "H5P_LINK_CREATE")
        check_pl(object_copy_pl, "H5P_OBJECT_COPY")

        herr <- .Call("R_H5Ocopy", src_loc$id, src_name, self$id, dst_name, object_copy_pl$id, link_create_pl$id, PACKAGE = "hdf5r")$return_val
        if(herr < 0) {
            stop("Error copying object")
        }
        return(invisible(self))
    },
    obj_info_by_idx=function(n, group_name=".", index_field=h5const$H5_INDEX_NAME, order=h5const$H5_ITER_NATIVE, remove_internal_use_only=TRUE) {
        "This function implements the HDF5-API function H5Oget_info_by_idx."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5O_GET_INFO_BY_IDX} for details."
        if(group_name!="." && !self$exists(group_name)) {
            stop(paste(group_name, " does not exist"))
        }
        res <- .Call("R_H5Oget_info_by_idx", self$id, group_name, index_field, order, n, request_empty(1), h5const$H5P_DEFAULT$id,
                     PACKAGE = "hdf5r")
        if(res$return_val < 0) {
            stop("Could not retrieve object info by index")
        }

        if(remove_internal_use_only) {
            oinfo <- res$oinfo
            oinfo$meta_size <- NULL
            return(oinfo)
        }
        else {
            return(res$oinfo)
        }
    },
    obj_info_by_name=function(object_name, remove_internal_use_only=TRUE) {
        "This function implements the HDF5-API function H5Oget_info_by_name."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5O_GET_INFO_BY_NAME} for details."

        if(!self$exists(object_name)) {
            stop(paste(object_name, " does not exist"))
        }
        res <- .Call("R_H5Oget_info_by_name", self$id, object_name, request_empty(1), h5const$H5P_DEFAULT$id,
                     PACKAGE = "hdf5r")
        if(res$return_val < 0) {
            stop("Could not retrieve object info by index")
        }
        if(remove_internal_use_only) {
            oinfo <- res$oinfo
            oinfo$meta_size <- NULL
            return(oinfo)
        }
        else {
            return(res$oinfo)
        }
    },
    group_info=function() {
        "This function implements the HDF5-API function H5Gget_info."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5G_GET_INFO} for details."

        res <- .Call("R_H5Gget_info", self$id, request_empty(1), PACKAGE = "hdf5r")
        if(res$return_val < 0) {
            stop("Error getting object info")
        }
        return(res$ginfo)
    },
    group_info_by_name=function(name, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Gget_info_by_name."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5G_GET_INFO_BY_NAME} for details."

        res <- .Call("R_H5Gget_info_by_name", self$id, name, request_empty(1), link_access_pl$id,
                     PACKAGE = "hdf5r")
        if(res$return_val < 0) {
            stop("Could not retrieve object info by index")
        }
        return(res$ginfo)
    },
    group_info_by_idx=function(n, group_name=".",  index_field=h5const$H5_INDEX_NAME, order=h5const$H5_ITER_NATIVE,
        link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Gget_info_by_idx."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5G_GET_INFO_BY_IDX} for details."

        if(group_name!="." && !self$exists(group_name)) {
            stop(paste(group_name, " does not exist"))
        }
        res <- .Call("R_H5Gget_info_by_idx", self$id, group_name, index_field, order, n, request_empty(1), link_access_pl$id,
                     PACKAGE = "hdf5r")
        if(res$return_val < 0) {
            stop("Could not retrieve object info by index")
        }
        return(res$ginfo)
    },
    create_group=function(name, link_create_pl=h5const$H5P_DEFAULT, group_create_pl=h5const$H5P_DEFAULT,
        group_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Gcreate2 and H5Gcreate_anon (if name is NULL). Please see the documentation at"
        "\\url{https://portal.hdfgroup.org/display/HDF5/H5G_CREATE2} for regular groups and"
        "\\url{https://portal.hdfgroup.org/display/HDF5/H5G_CREATE_ANON} for anonymous groups for details."

        if(!(is.null(name) || is.character(name))) {
            stop("name has to be NULL or a character vector")
        }
        if(length(name) > 1) {
            stop("name has to be of length at most 1")
        }

        check_pl(link_create_pl, "H5P_LINK_CREATE")
        check_pl(group_create_pl, "H5P_GROUP_CREATE")
        check_pl(group_access_pl, "H5P_GROUP_ACCESS")

        if(length(name)==0) { ## create anonymous group
            id <- .Call("R_H5Gcreate_anon", self$id, group_create_pl$id, group_access_pl$id, PACKAGE = "hdf5r")$return_val
        }
        else {
            id <- .Call("R_H5Gcreate2", self$id, name, group_create_pl$id, link_create_pl$id, group_access_pl$id, PACKAGE = "hdf5r")$return_val
        }
        if(id < 0) {
            stop("Error when creating group")
        }
        return(H5Group$new(id))
    },
    create_dataset=function(name, robj=NULL, dtype=NULL, space=NULL, dims=NULL, chunk_dims="auto", gzip_level=4,
        link_create_pl=h5const$H5P_DEFAULT, dataset_create_pl=h5const$H5P_DEFAULT, dataset_access_pl=h5const$H5P_DEFAULT) {
        "This function is the main interface to create a new dataset. Its parameters allow for customization of the default"
        "behavior, i.e. in order to get a specific datatype, a certain chunk size or dataset dimensionality."
        "Also note that this function implements the HDF5-API function H5Dcreate2 and H5Dcreate_anon (if name is NULL). Please see the documentation at"
        "\\url{https://portal.hdfgroup.org/display/HDF5/H5D_CREATE2} for regular groups and"
        "\\url{https://portal.hdfgroup.org/display/HDF5/H5D_CREATE_ANON} for anonymous groups for details."
        "@param name The name of the new dataset. If missing, an anonymous dataset is created"
        "@param robj An R-object to take as a template for creating the dataset. Either \\code{robj} or both \\code{dtype} and {space}"
        "have to be provided"
        "@param dtype The datatype to use for the creation of the object. Can be null if \\code{robj} is given."
        "@param space The space to use for the object creation. Can be null if \\code{robj} is given. Otherwise an object of type \\code{H5S} which specifies the dimensions of the dataset."
        "@param dims Dimension of the new dataset; used if \\code{space} is \\code{NULL}. overwrite the dimension guessed from \\code{robj}"
        "if \\code{robj} is given."
        "@param chunk_dims Size of the chunk. Has to have the same length as the dataset dimension. If \\code{\"auto\"}"
        "then the size of each chunk is estimated so that each chunk is roughly as large in bytes as the value in"
        "the \\code{hdf5r.chunk_size} option. See also \\code{\\link{guess_chunks}} for a more detailed explanation."
        "If set to \\code{NULL}, then no chunking is used, unless explicitly set in \\code{dataset_create_pl}."
        "@param gzip_level Only if \\code{chunk_dims} is not null. If given, then the \\code{dataset_create_pl} is set to enable zipping"
        "at the level given here. If set to NULL, then gzip is not set (but could be set otherwise in \\code{dataset_create_pl}"
        "@param link_create_pl Link creation property list. See \\code{\\link{H5P_LINK_CREATE}}"
        "@param dataset_create_pl Dataset creation property list. See \\code{\\link{H5P_DATASET_CREATE}}"
        "@param dataset_access_pl Dataset access property list. See \\code{\\link{H5P_DATASET_ACCESS}}"


        if(missing(name)) {
            name <- character(0)
        }
        else {
            if(self$exists(name)) {
                stop(paste("Can't create dataset", name, "- already exists!"))
            }
        }
        ## check that all parameters are of the expected type
        if(!is.character(name) && !is.null(name)) {
            stop("Name has to be a character vector or null")
        }
        if(length(name) > 1) {
            stop("name has to be of length at most 1")
        }

        ## check that enough data is given to determine size of space
        if(is.null(robj)) {
            if(is.null(dtype)) {
                stop("If a sample robj is not provided, then dtype has to be given")
            }
            else {
                if(is.null(space) && is.null(dims)) {
                    stop("If a sample robj is not provided, space or dims has to be given")
                }
            }
        }
        ## adapt dtype, space as necessary
        if(is.null(dtype)) {
            dtype <- guess_dtype(x=robj, scalar=FALSE, string_len=Inf)
        }
        if(is.null(space)) {
            if(is.null(dims)) {
                if(!is.null(chunk_dims)) {
                    space <- guess_space(x=robj, dtype=dtype, chunked=TRUE)
                }
                else {
                    space <- guess_space(x=robj, dtype=dtype, chunked=FALSE)
                }
            }
            else {
                if(!is.null(chunk_dims)) {
                    space <- H5S$new(type="simple", dims=dims, maxdims=rep(Inf, length(dims)))
                }
                else {
                    space <- H5S$new(type="simple", dims=dims, maxdims=dims)
                }
            }
        }

        ## now manipulate the dataset_create_pl
        if(!is.null(chunk_dims)) {
            if(dataset_create_pl$id == h5const$H5P_DEFAULT$id) {
                dataset_create_pl <- H5P_DATASET_CREATE$new()
            }
            else {
                dataset_create_pl <- dataset_create_pl$copy()
            }
            if(length(chunk_dims) == 1 && chunk_dims=="auto") {
                if(inherits(dtype, "H5T_STRING")) {
                    dtype_size <- dtype$get_size(variable_as_inf=FALSE)
                }
                else {
                    dtype_size <- dtype$get_size()
                }
                space_extent <- space$get_simple_extent_dims()
                chunk_dims <- guess_chunks(space_maxdims=space_extent$maxdims, dtype_size=dtype_size)
            }
            ## check that chunk_dims has the same rank as space
            if(!space$is_simple()) {
                stop("When chunking is enable, the space has to be simple")
            }
            space_rank <- space$get_simple_extent_ndims()
            if(space_rank != length(chunk_dims)) {
                stop(paste("The length of the chunk_dims is", length(chunk_dims), "and has to be the same as the rank of the space", space_rank))
            }
            dataset_create_pl$set_chunk(chunk_dims)
            if(!is.null(gzip_level)) {
                if(0 > gzip_level || gzip_level > 9) {
                    stop(paste("gzip_level has to be between 0 and 9, but is", gzip_level))
                }
                dataset_create_pl$set_deflate(gzip_level)
            }
        }

        check_class(dtype, "H5T")
        check_class(space, "H5S")
        check_pl(link_create_pl, "H5P_LINK_CREATE")
        check_pl(dataset_create_pl, "H5P_DATASET_CREATE")
        check_pl(dataset_access_pl, "H5P_DATASET_ACCESS")

        if(is.character(name) && length(name)==1) {
            id <- .Call("R_H5Dcreate2", self$id, name, dtype$id, space$id, link_create_pl$id, dataset_create_pl$id,
                        dataset_access_pl$id, PACKAGE="hdf5r")$return_val
        }
        else if(length(name)==0) {
            id <- .Call("R_H5Dcreate_anon", self$id, dtype$id, space$id,  dataset_create_pl$id,
                        dataset_access_pl$id, PACKAGE="hdf5r")$return_val
        }
        else {
            stop("This should not have happened! name has to be character or null")
        }
        if(id < 0) {
            stop("An error occured creating the dataset")
        }
        ds <- H5D$new(id)
        if(!is.null(robj)) {
            ## need to write the sample object data
            ds$write_low_level(robj)
        }
        return(invisible(ds))
    },
    commit=function(name, dtype, link_create_pl=h5const$H5P_DEFAULT, type_create_pl=h5const$H5P_DEFAULT,
        type_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Tcommit2."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5T_COMMIT2} for details."

        if(missing(name)) {
            name <- character(0)
        }
        ## check that all parameters are of the expected type
        if(!is.character(name) && !is.null(name)) {
            stop("Name has to be a character vector or null")
        }
        if(length(name) > 1) {
            stop("name has to be of length at most 1")
        }

        check_pl(link_create_pl, "H5P_LINK_CREATE")
        check_pl(type_create_pl, "H5P_TYPE_CREATE")
        check_pl(type_access_pl, "H5P_TYPE_ACCESS")

        if(is.character(name) && length(name)==1) {
            herr <- .Call("R_H5Tcommit2", self$id, name, dtype$id, link_create_pl$id, type_create_pl$id,
                        type_access_pl$id, PACKAGE="hdf5r")$return_val
        }
        else if(length(name)==0) {
            herr <- .Call("R_H5Tcommit_anon", self$id, dtype$id, type_create_pl$id,
                        type_access_pl$id, PACKAGE="hdf5r")$return_val
        }
        else {
            stop("This should not have happened! name has to be character or null")
        }
        if(herr < 0) {
            stop("An error occured creating the dataset")
        }
        return(invisible(dtype))

    },
    ## functions around the link interface
    link_create_hard=function(obj_loc, obj_name, link_name, link_create_pl=h5const$H5P_DEFAULT, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Lcreate_hard."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5L_CREATE_HARD} for details."

        if(!(inherits(obj_loc, "H5File") || inherits(obj_loc, "H5Group"))) {
            stop("src_loc has to be a file or group")
        }
        check_pl(link_access_pl, "H5P_LINK_ACCESS")
        check_pl(link_create_pl, "H5P_LINK_CREATE")

        herr <- .Call("R_H5Lcreate_hard", obj_loc$id, obj_name, self$id, link_name, link_create_pl$id,
                      link_access_pl$id, PACKAGE="hdf5r")$return_val
        if(herr < 0) {
            stop(paste("Error creating hard link for object", obj_name, "with link_name", link_name))
        }
        return(invisible(self))
    },
    link_create_soft=function(target_path, link_name, link_create_pl=h5const$H5P_DEFAULT, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Lcreate_soft."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5L_CREATE_SOFT} for details."

        check_pl(link_access_pl, "H5P_LINK_ACCESS")
        check_pl(link_create_pl, "H5P_LINK_CREATE")

        herr <- .Call("R_H5Lcreate_soft", target_path, self$id, link_name, link_create_pl$id,
                      link_access_pl$id, PACKAGE="hdf5r")$return_val
        if(herr < 0) {
            stop(paste("Error creating soft link for path", target_path, "with link_name", link_name))
        }
        return(invisible(self))

    },
    link_create_external=function(target_filename, target_obj_name, link_name, link_create_pl=h5const$H5P_DEFAULT,
        link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Lcreate_external."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5L_CREATE_EXTERNAL} for details."

        check_pl(link_access_pl, "H5P_LINK_ACCESS")
        check_pl(link_create_pl, "H5P_LINK_CREATE")

        herr <- .Call("R_H5Lcreate_external", target_filename, target_obj_name, self$id, link_name, link_create_pl$id,
                      link_access_pl$id, PACKAGE="hdf5r")$return_val
        if(herr < 0) {
            stop(paste("Error creating external link for file", target_filename, "with target object", target_obj_name, " and link_name", link_name))
        }
        return(invisible(self))

    },
    link_exists=function(name, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Lexists."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5L_EXISTS} for details."

        check_pl(link_access_pl, "H5P_LINK_ACCESS")

        htri <- .Call("R_H5Lexists", self$id, name, link_access_pl$id, PACKAGE="hdf5r")$return_val
        if(htri < 0) {
            stop(paste("Error verifying existence of link", name))
        }
        return(as.logical(htri))
    },
    link_move_from=function(src_loc, src_name, dst_name, link_create_pl=h5const$H5P_DEFAULT, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Lmove."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5L_MOVE} for details."

        if(!(inherits(src_loc, "H5File") || inherits(src_loc, "H5Group"))) {
            stop("src_loc has to be a file or group")
        }
        check_pl(link_access_pl, "H5P_LINK_ACCESS")
        check_pl(link_create_pl, "H5P_LINK_CREATE")

        herr <- .Call("R_H5Lmove", src_loc$id, src_name, self$id, dst_name, link_create_pl$id, link_access_pl$id, PACKAGE = "hdf5r")$return_val
        if(herr < 0) {
            stop("Error copying object")
        }
        return(invisible(self))

    },
    link_move_to=function(dst_loc, dst_name, src_name, link_create_pl=h5const$H5P_DEFAULT, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Lmove."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5L_MOVE} for details."

        if(!(inherits(dst_loc, "H5File") || inherits(dst_loc, "H5Group"))) {
            stop("src_loc has to be a file or group")
        }
        check_pl(link_access_pl, "H5P_LINK_ACCESS")
        check_pl(link_create_pl, "H5P_LINK_CREATE")

        herr <- .Call("R_H5Lmove", self$id, src_name, dst_loc$id, dst_name, link_create_pl$id, link_access_pl$id, PACKAGE = "hdf5r")$return_val
        if(herr < 0) {
            stop("Error copying object")
        }
        return(invisible(self))

    },
    link_copy_from=function(src_loc, src_name, dst_name, link_create_pl=h5const$H5P_DEFAULT, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Lcopy."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5L_COPY} for details."

        if(!(inherits(src_loc, "H5File") || inherits(src_loc, "H5Group"))) {
            stop("src_loc has to be a file or group")
        }
        check_pl(link_access_pl, "H5P_LINK_ACCESS")
        check_pl(link_create_pl, "H5P_LINK_CREATE")

        herr <- .Call("R_H5Lcopy", src_loc$id, src_name, self$id, dst_name, link_create_pl$id, link_access_pl$id, PACKAGE = "hdf5r")$return_val
        if(herr < 0) {
            stop("Error copying object")
        }
        return(invisible(self))

    },
    link_copy_to=function(dst_loc, dst_name, src_name, link_create_pl=h5const$H5P_DEFAULT, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Lcopy."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5L_COPY} for details."

        if(!(inherits(dst_loc, "H5File") || inherits(dst_loc, "H5Group"))) {
            stop("src_loc has to be a file or group")
        }
        check_pl(link_access_pl, "H5P_LINK_ACCESS")
        check_pl(link_create_pl, "H5P_LINK_CREATE")

        herr <- .Call("R_H5Lcopy", self$id, src_name, dst_loc$id, dst_name, link_create_pl$id, link_access_pl$id, PACKAGE = "hdf5r")$return_val
        if(herr < 0) {
            stop("Error copying object")
        }
        return(invisible(self))

    },
    link_delete=function(name, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Ldelete."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5L_DELETE} for details."

        check_pl(link_access_pl, "H5P_LINK_ACCESS")

        herr <- .Call("R_H5Ldelete", self$id, name, link_access_pl$id, PACKAGE="hdf5r")$return_val
        if(herr < 0) {
            stop(paste("Error deleting link", name))
        }
        return(invisible(self))

    },
    link_delete_by_idx=function(n, group_name=".", index_field=h5const$H5_INDEX_NAME, order=h5const$H5_ITER_NATIVE,
        link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Ldelete_by_idx."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5L_DELETE_BY_IDX} for details."

        check_pl(link_access_pl, "H5P_LINK_ACCESS")

        if(group_name!="." && !self$exists(group_name)) {
            stop(paste(group_name, " does not exist"))
        }

        herr <- .Call("R_H5Ldelete_by_idx", self$id, group_name, index_field, order, n, link_access_pl$id, PACKAGE="hdf5r")$return_val
        if(herr < 0) {
            stop(paste("Error deleting link number", n, "in group", group_name))
        }
        return(invisible(self))

    },
    link_info=function(name, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Lget_info."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5L_GET_INFO} for details."

        check_pl(link_access_pl, "H5P_LINK_ACCESS")

        res <- .Call("R_H5Lget_info", self$id, name, request_empty(1), link_access_pl$id, PACKAGE="hdf5r")
        if(res$return_val < 0) {
            stop(paste("Error getting info for link", name))
        }
        return(res$linfo)
    },
    link_info_by_idx=function(n, group_name=".", index_field=h5const$H5_INDEX_NAME, order=h5const$H5_ITER_NATIVE,
        link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Lget_info_by_idx."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5L_GET_INFO_BY_IDX} for details."

        check_pl(link_access_pl, "H5P_LINK_ACCESS")

        if(group_name!="." && !self$exists(group_name)) {
            stop(paste(group_name, " does not exist"))
        }

        res <- .Call("R_H5Lget_info_by_idx", self$id, group_name, index_field, order, n, request_empty(1),
                      link_access_pl$id, PACKAGE="hdf5r")
        if(res$return_val < 0) {
            stop(paste("Error getting info for link number", n, "in group", group_name))
        }
        return(res$linfo)
    },
    link_value=function(name, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Lget_val."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5L_GET_VAL} for details."

        ## first check if it is a soft or external link, otherwise return NA
        linfo <- self$link_info(name=name, link_access_pl=link_access_pl)
        if(!(as.character(linfo$type) %in% c("H5L_TYPE_SOFT", "H5L_TYPE_EXTERNAL"))) {
            return(NA)
        }
        ## first get the link-value; then unpack if necessary
        buffer <- raw(linfo$u$address) ## isn't the haddr, is the size_val; as it is a union, has been dropped
        res <- .Call("R_H5Lget_val", self$id, name, buffer, linfo$u$address, link_access_pl$id, FALSE, PACKAGE="hdf5r")
        if(res$return_val < 0) {
            stop(paste("Error retrieving link value of link", name))
        }
        if(as.character(linfo$type) == "H5L_TYPE_SOFT") {
            ## link is a character vector
            val <- rawToChar(res$buf)
            return(val)
        }
        else { ## external
            ## needs to be unpacked
            ## can do this here; just 2 null terminated strings; have it as raw, so just unpack it
            buffer <- res$buf
            string_ends <- which(buffer==0)
            if(length(string_ends) != 3) {
                stop("Expected 2 strings with a null at the beginning; received more")
            }
            file_name <- rawToChar(buffer[2:string_ends[2]])
            obj_name <- rawToChar(buffer[(string_ends[2] + 1):string_ends[3]])
            return(list(file_name=file_name, obj_name=obj_name))
        }
    },
    link_value_by_idx=function(n, group_name=".", index_field=h5const$H5_INDEX_NAME, order=h5const$H5_ITER_NATIVE,
        link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Lget_val_by_idx."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5L_GET_VAL_BY_IDX} for details."

        check_pl(link_access_pl, "H5P_LINK_ACCESS")

        if(group_name!="." && !self$exists(group_name)) {
            stop(paste(group_name, " does not exist"))
        }

        linfo <- self$link_info_by_idx(n=n, group_name=group_name, index_field=index_field, order=order, link_access_pl=link_access_pl)
        if(!(as.character(linfo$type) %in% c("H5L_TYPE_SOFT", "H5L_TYPE_EXTERNAL"))) {
            return(NA)
        }
        ## first get the link-value; then unpack if necessary
        buffer <- raw(linfo$u$address) ## isn't the haddr, is the size_val; as it is a union, has been dropped
        res <- .Call("R_H5Lget_val_by_idx", self$id, group_name, index_field, order, n, buffer, linfo$u$address,
                     link_access_pl$id, FALSE, PACKAGE="hdf5r")
        if(res$return_val < 0) {
            stop(paste("Error retrieving link value of link", name))
        }
        if(as.character(linfo$type) == "H5L_TYPE_SOFT") {
            ## link is a character vector
            val <- rawToChar(res$buf)
            return(val)
        }
        else { ## external
            ## needs to be unpacked
            ## can do this here; just 2 null terminated strings; have it as raw, so just unpack it
            buffer <- res$buf
            string_ends <- which(buffer==0)
            if(length(string_ends) != 3) {
                stop("Expected 2 strings with a null at the beginning; received more")
            }
            file_name <- rawToChar(buffer[2:string_ends[2]])
            obj_name <- rawToChar(buffer[(string_ends[2] + 1):string_ends[3]])
            return(list(file_name=file_name, obj_name=obj_name))
        }

    },
    link_name_by_idx=function(n, group_name, idx_type=h5const$H5_INDEX_NAME, order=h5const$H5_ITER_NATIVE, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Lget_name_by_idx."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5L_GET_NAME_BY_IDX} for details."

        check_pl(link_access_pl, "H5P_LINK_ACCESS")

        if(group_name!="." && !self$exists(group_name)) {
            stop(paste(group_name, " does not exist"))
        }
        name_size <- .Call("R_H5Lget_name_by_idx", self$id, group_name, idx_type, order, n, character(0), 0,
                           link_access_pl$id, PACKAGE="hdf5r")$return_val
        char_buf <- paste(rep(" ", name_size+1), collapse="")
        res <- .Call("R_H5Lget_name_by_idx", self$id, group_name, idx_type, order, n, char_buf, name_size+1,
                     link_access_pl$id, PACKAGE="hdf5r")

        if(res$return_val < 0) {
            stop("Problem getting name of link by index")
        }
        return(res$name)

    },
    mount=function(name, child) {
        "This function implements the HDF5-API function H5Fmount."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5F_MOUNT} for details."
        if(!is.character(name) || length(name) != 1) {
            stop("name has to be a character vector of length 1")
        }
        ## check that name actually exists
        if(!self$path_valid(name)) {
            stop(paste("path", name, "does not exist"))
        }
        check_class(child, "H5File")
        file_mount_pl <- h5const$H5P_DEFAULT
        res <- .Call("R_H5Fmount", self$id, name, child$id, file_mount_pl$id, PACKAGE="hdf5r")$return_val
        if(res <- 0) {
            stop("Error mounting file onto group")
        }
        return(self$open(name))
    },
    unmount=function(name) {
        "This function implements the HDF5-API function H5Funmount."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5F_UNMOUNT} for details."
        if(!is.character(name) || length(name) != 1) {
            stop("name has to be a character vector of length 1")
        }
        ## check that name actually exists
        if(!self$path_valid(name)) {
            stop(paste("path", name, "does not exist"))
        }
        res <- .Call("R_H5Funmount", self$id, name, PACKAGE="hdf5r")$return_val
        if(res <- 0) {
            stop("Error mounting file onto group")
        }
        return(self)
    }
    )




commonFG_active <- list(
        names=function(link_access_pl=h5const$H5P_DEFAULT) {
        "Returns the names of the items in the group or at the root of the file"
        "@param link_access_pl The link-access property list. See \\url{https://portal.hdfgroup.org/display/HDF5/Link+Access+Properties} for more detail."
        ginfo <- self$group_info()
        nlinks <- ginfo$nlinks
        res <- character(nlinks)
        for(i in seq_len(nlinks)) {
            res[i] <- self$link_name_by_idx(i-1, ".", idx_type=h5const$H5_INDEX_NAME, order=h5const$H5_ITER_INC,
                                         link_access_pl=link_access_pl)
        }
        return(res)
    }
)







commonFGDT <- list(
    obj_info=function(remove_internal_use_only=TRUE) {
        "This function implements the HDF5-API function H5Oget_info."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5O_GET_INFO} for details."

        res <- .Call("R_H5Oget_info", self$id, request_empty(1), PACKAGE = "hdf5r")
        if(res$return_val < 0) {
            stop("Error getting object info")
        }
        if(remove_internal_use_only) {
            oinfo <- res$oinfo
            oinfo$meta_size <- NULL
            return(oinfo)
        }
        else {
            return(res$oinfo)
        }
    },
    get_obj_name=function() {
        "This function implements the HDF5-API function H5Iget_name."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5I_GET_NAME} for details."

        ## get size of the name
        name_size <- .Call("R_H5Iget_name", self$id, character(0), 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), collapse="")
        res <- .Call("R_H5Iget_name", self$id, char_buf, name_size + 1, PACKAGE="hdf5r")
        if(res$return_val < 0) {
            stop("Error returning name of object")
        }
        return(res$name)
    },
    ## functions that work on attributes
    create_attr=function(attr_name, robj=NULL, dtype=NULL, space=NULL) {
        "This function implements the HDF5-API function H5Acreate2."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_CREATE2} for details."

        if(!is.character(attr_name) || length(attr_name) != 1) {
            stop("'attr_name' has to be a character vector of length 1")
        }
        if(self$attr_exists(attr_name)) {
            stop("Can't create attribute; already exists")
        }

        attr_create_pl <- h5const$H5P_DEFAULT
        attr_access_pl <- h5const$H5P_DEFAULT

        ## adapt dtype, space as necessary
        if(is.null(robj) && (is.null(dtype) || is.null(space))) {
            stop("If a sample robj is not provided, both dtype and space have to be given")
        }
        if(is.null(dtype)) {
            dtype <- guess_dtype(x=robj, scalar=FALSE, string_len=Inf)
        }
        if(is.null(space)) {
            space <- guess_space(x=robj, dtype=dtype, chunked=FALSE)
        }

        id <- .Call("R_H5Acreate2", self$id, attr_name, dtype$id, space$id,
                     attr_create_pl$id, attr_access_pl$id, PACKAGE="hdf5r")$return_val

        if(id < 0) {
            stop("Problem creating new attribute")
        }
        attr <- H5A$new(id=id)
        if(!is.null(robj)) {
            attr$write(robj)
        }
        return(attr)
    },
    attr_open=function(attr_name) {
        "This function implements the HDF5-API function H5Aopen."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_OPEN} for details."

        if(!is.character(attr_name) || length(attr_name) != 1) {
            stop("'attr_name' has to be a character vector of length 1")
        }
        attr_access_pl=h5const$H5P_DEFAULT
        id <- .Call("R_H5Aopen", self$id, attr_name, attr_access_pl$id, PACKAGE="hdf5r")$return_val

        if(id < 0) {
            stop("Problem creating new attribute")
        }
        return(H5A$new(id=id))
    },
    create_attr_by_name=function(attr_name, obj_name, robj=NULL, dtype=NULL, space=NULL, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Acreate_by_name."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_CREATE_BY_NAME} for details."

        check_pl(link_access_pl, "H5P_LINK_ACCESS")

        if(!is.character(obj_name) || length(obj_name) != 1) {
            stop("'obj_name' has to be a character vector of length 1")
        }
        if(!is.character(attr_name) || length(attr_name) != 1) {
            stop("'attr_name' has to be a character vector of length 1")
        }
        attr_create_pl <- h5const$H5P_DEFAULT
        attr_access_pl <- h5const$H5P_DEFAULT

        if(is.null(robj) && (is.null(dtype) || is.null(space))) {
            stop("If a sample robj is not provided, both dtype and space have to be given")
        }
        if(is.null(dtype)) {
            dtype <- guess_dtype(x=robj, scalar=FALSE, string_len=Inf)
        }
        if(is.null(space)) {
            space <- guess_space(x=robj, dtype=dtype, chunked=FALSE)
        }

        id <- .Call("R_H5Acreate_by_name", self$id, obj_name, attr_name, dtype$id, space$id,
                     attr_create_pl$id, attr_access_pl$id, link_access_pl$id, PACKAGE="hdf5r")$return_val

        if(id < 0) {
            stop("Problem creating new attribute")
        }
        attr <- H5A$new(id=id)
        if(!is.null(robj)) {
            attr$write(robj)
        }
        return(attr)

    },
    attr_open_by_name=function(attr_name, obj_name, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Aopen_by_name."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_OPEN_BY_NAME} for details."

        check_pl(link_access_pl, "H5P_LINK_ACCESS")

        if(!is.character(obj_name) || length(obj_name) != 1) {
            stop("'obj_name' has to be a character vector of length 1")
        }
        if(!is.character(attr_name) || length(attr_name) != 1) {
            stop("'attr_name' has to be a character vector of length 1")
        }
        attr_access_pl=h5const$H5P_DEFAULT
        id <- .Call("R_H5Aopen_by_name", self$id, obj_name, attr_name, attr_access_pl$id, link_access_pl$id, PACKAGE="hdf5r")$return_val

        if(id < 0) {
            stop("Problem creating new attribute")
        }
        return(H5A$new(id=id))
    },
    attr_open_by_idx=function(n, obj_name, idx_type=h5const$H5_INDEX_NAME, order=h5const$H5_ITER_NATIVE, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Aopen_by_idx."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_OPEN_BY_IDX} for details."

        check_pl(link_access_pl, "H5P_LINK_ACCESS")

        if(!is.character(obj_name) || length(obj_name) != 1) {
            stop("'obj_name' has to be a character vector of length 1")
        }
        attr_access_pl=h5const$H5P_DEFAULT
        id <- .Call("R_H5Aopen_by_idx", self$id, obj_name, idx_type, order, n, attr_access_pl$id, link_access_pl$id, PACKAGE="hdf5r")$return_val

        if(id < 0) {
            stop("Problem creating new attribute")
        }
        return(H5A$new(id=id))

    },
    attr_exists_by_name=function(attr_name, obj_name, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Aexists_by_name."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_EXISTS_BY_NAME} for details."
        check_pl(link_access_pl, "H5P_LINK_ACCESS")

        if(!is.character(obj_name) || length(obj_name) != 1) {
            stop("'obj_name' has to be a character vector of length 1")
        }
        if(!is.character(attr_name) || length(attr_name) != 1) {
            stop("'attr_name' has to be a character vector of length 1")
        }
        res <- .Call("R_H5Aexists_by_name", self$id, obj_name, attr_name, link_access_pl$id, PACKAGE="hdf5r")$return_val
        if(res < 0) {
            stop(paste("Error trying to check existence of attribute", attr_name))
        }
        return(as.logical(res))
    },
    attr_exists=function(attr_name) {
        "This function implements the HDF5-API function H5Aexists."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_EXISTS} for details."

        if(!is.character(attr_name) || length(attr_name) != 1) {
            stop("'attr_name' has to be a character vector of length 1")
        }
        res <- .Call("R_H5Aexists", self$id, attr_name, PACKAGE="hdf5r")$return_val
        if(res < 0) {
            stop(paste("Error trying to check existence of attribute", attr_name))
        }
        return(as.logical(res))
    },
   attr_rename_by_name=function(old_attr_name, new_attr_name, obj_name, link_access_pl=h5const$H5P_DEFAULT) {
       "This function implements the HDF5-API function H5Arename_by_name."
       "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_RENAME_BY_NAME} for details."

       check_pl(link_access_pl, "H5P_LINK_ACCESS")

        if(!is.character(obj_name) || length(obj_name) != 1) {
            stop("'obj_name' has to be a character vector of length 1")
        }
        if(!is.character(old_attr_name) || length(old_attr_name) != 1) {
            stop("'old_attr_name' has to be a character vector of length 1")
        }
        if(!is.character(new_attr_name) || length(new_attr_name) != 1) {
            stop("'new_attr_name' has to be a character vector of length 1")
        }
        res <- .Call("R_H5Arename_by_name", self$id, obj_name, old_attr_name, new_attr_name, link_access_pl$id, PACKAGE="hdf5r")$return_val
        if(res < 0) {
            stop(paste("Error renaming attribute from", old_attr_name, "to", new_attr_name))
        }
        return(invisible(self))
    },
    attr_rename=function(old_attr_name, new_attr_name) {
        "This function implements the HDF5-API function H5Arename."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_RENAME} for details."

        if(!is.character(old_attr_name) || length(old_attr_name) != 1) {
            stop("'old_attr_name' has to be a character vector of length 1")
        }
        if(!is.character(new_attr_name) || length(new_attr_name) != 1) {
            stop("'new_attr_name' has to be a character vector of length 1")
        }
        res <- .Call("R_H5Arename", self$id, old_attr_name, new_attr_name, PACKAGE="hdf5r")$return_val
        if(res < 0) {
            stop(paste("Error renaming attribute from", old_attr_name, "to", new_attr_name))
        }
        return(invisible(self))
    },
    attr_delete=function(attr_name) {
        "This function implements the HDF5-API function H5Adelete."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_DELETE} for details."

        if(!is.character(attr_name) || length(attr_name) != 1) {
            stop("'attr_name' has to be a character vector of length 1")
        }
        herr <- .Call("R_H5Adelete", self$id, attr_name, PACKAGE="hdf5r")$return_val
        if(herr < 0) {
            stop(paste("Error trying to delete attribute", attr_name))
        }
        return(invisible(self))
    },
    attr_delete_by_name=function(attr_name, obj_name, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Adelete_by_name."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_DELETE_BY_NAME} for details."

        check_pl(link_access_pl, "H5P_LINK_ACCESS")
        if(!is.character(obj_name) || length(obj_name) != 1) {
            stop("'obj_name' has to be a character vector of length 1")
        }
        if(!is.character(attr_name) || length(attr_name) != 1) {
            stop("'attr_name' has to be a character vector of length 1")
        }
        id <- .Call("R_H5Adelete_by_name", self$id, obj_name, attr_name, link_access_pl$id, PACKAGE="hdf5r")$return_val

        if(id < 0) {
            stop("Problem deleting attribute by name")
        }
        return(invisible(self))
    },
    attr_delete_by_idx=function(n, obj_name, idx_type=h5const$H5_INDEX_NAME, order=h5const$H5_ITER_NATIVE, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Adelete_by_idx."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_DELETE_BY_IDX} for details."

        check_pl(link_access_pl, "H5P_LINK_ACCESS")
        if(!is.character(obj_name) || length(obj_name) != 1) {
            stop("'obj_name' has to be a character vector of length 1")
        }
        id <- .Call("R_H5Adelete_by_idx", self$id, obj_name, idx_type, order, n, link_access_pl$id, PACKAGE="hdf5r")$return_val

        if(id < 0) {
            stop("Problem deleting attribute by index")
        }
        return(invisible(self))

    },
    attr_info_by_name=function(attr_name, obj_name, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Aget_info_by_name."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_GET_INFO_BY_NAME} for details."

        check_pl(link_access_pl, "H5P_LINK_ACCESS")
        if(!is.character(obj_name) || length(obj_name) != 1) {
            stop("'obj_name' has to be a character vector of length 1")
        }
        if(!is.character(attr_name) || length(attr_name) != 1) {
            stop("'attr_name' has to be a character vector of length 1")
        }
        res <- .Call("R_H5Aget_info_by_name", self$id, obj_name, attr_name, request_empty(1), link_access_pl$id, PACKAGE="hdf5r")

        if(res$return_val < 0) {
            stop("Problem getting attribute info by name")
        }
        return(res$ainfo)
    },
    attr_info_by_idx=function(n, obj_name, idx_type=h5const$H5_INDEX_NAME, order=h5const$H5_ITER_NATIVE, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Aget_info_by_idx."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_GET_INFO_BY_IDX} for details."

        check_pl(link_access_pl, "H5P_LINK_ACCESS")
        if(!is.character(obj_name) || length(obj_name) != 1) {
            stop("'obj_name' has to be a character vector of length 1")
        }
        res <- .Call("R_H5Aget_info_by_idx", self$id, obj_name, idx_type, order, n, request_empty(1), link_access_pl$id, PACKAGE="hdf5r")

        if(res$return_val < 0) {
            stop("Problem getting atribute info by index")
        }
        return(res$ainfo)
    },
    attr_name_by_idx=function(n, obj_name, idx_type=h5const$H5_INDEX_NAME, order=h5const$H5_ITER_NATIVE, link_access_pl=h5const$H5P_DEFAULT) {
        "This function implements the HDF5-API function H5Aget_name_by_idx."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5A_GET_NAME_BY_IDX} for details."

        check_pl(link_access_pl, "H5P_LINK_ACCESS")
        if(!is.character(obj_name) || length(obj_name) != 1) {
            stop("'obj_name' has to be a character vector of length 1")
        }
        name_size <- .Call("R_H5Aget_name_by_idx", self$id, obj_name, idx_type, order, n, character(0), 0,
                           link_access_pl$id, PACKAGE="hdf5r")$return_val
        char_buf=paste(rep(" ", name_size+1), collapse="")
        res <- .Call("R_H5Aget_name_by_idx", self$id, obj_name, idx_type, order, n, char_buf, name_size+1,
                     link_access_pl$id, PACKAGE="hdf5r")

        if(res$return_val < 0) {
            stop("Problem getting attribute name by index")
        }
        return(res$name)
    },
    attr_get_number=function() {
        "This function implements the HDF5-API function H5Aget_num_attrs."
        "Please see the documentation at \\url{https://support.hdfgroup.org/HDF5/doc/RM/RM_H5A.html#Annot-NumAttrs} for details."
        res <- .Call("R_H5Aget_num_attrs", self$id, PACKAGE="hdf5r")
        return(res$return_val)
    }
)


## create reference for datasets is implemented separately to allower for better ease of use in creating
## H5R_DATASET_REGION references
commonFGT <- list(
    create_reference=function(name=".", space=NULL) {
        "This function implements the HDF5-API function H5Rcreate. If \\code{space=NULL} then a \\code{H5R_OBJECT} reference"
        "is created, otherwise a \\code{H5R_DATASET_REGION} reference"
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5R_CREATE} for details."

        if(is.null(space)) {
            ref_type <- h5const$H5R_OBJECT
            space_id <- -1
            ref_obj <- H5R_OBJECT$new(1, self)
        }
        else {
            ref_type <- h5const$H5R_DATASET_REGION
            space_id <- space$id
            ref_obj <- H5R_DATASET_REGION$new(1, self)
        }

        res <- .Call("R_H5Rcreate", ref_obj$ref, self$id, name, ref_type, space_id, FALSE, PACKAGE="hdf5r")
        if(res$return_val < 0) {
            stop("Error creating object reference")
        }
        ref_obj$ref <- res$ref
        return(ref_obj)
    }
)

commonFGDTA <- list(
    flush=function(scope=h5const$H5F_SCOPE_GLOBAL) {
        "This function implements the HDF5-API function H5Fflush."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5F_FLUSH} for details."

        if(self$is_valid) {
            res <- .Call("R_H5Fflush", self$id, scope, PACKAGE="hdf5r")$return_val
            if(res < 0) {
                stop("Error flushing associated file")
            }
            return(invisible(self))
        }
        else {
            return(invisible(self))
        }
    },
    get_filename=function() {
        "This function implements the HDF5-API function H5Fget_name."
        "Please see the documentation at \\url{https://portal.hdfgroup.org/display/HDF5/H5F_GET_NAME} for details."

        ## get size of the name
        name_size <- .Call("R_H5Fget_name", self$id, character(0), 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), collapse="")
        res <- .Call("R_H5Fget_name", self$id, char_buf, name_size + 1, PACKAGE="hdf5r")
        if(res$return_val < 0) {
            stop("Error returning name of object")
        }
        return(res$name)
    }
)

Try the hdf5r package in your browser

Any scripts or data that you put into this service are public.

hdf5r documentation built on Nov. 16, 2021, 1:06 a.m.