R/BgeeMetadata.R

In BgeeCall: Automatic RNA-Seq present/absent gene expression calls generation

#' @title BgeeMetadata S4 class
#'
#' @description An S4 class that contains all information to retrieve
#' intergenic regions generated by Bgee.
#'
#' @slot intergenic_release Bgee intergenic release that will be used
#' @slot all_releases list of all reference intergenic releases that can be
#' used to generate your present/absent expression calls.
#' @slot intergenic_prefix String used to generate an intergenic release
#' specific output directory
#'
BgeeMetadata <- setClass(
    # Set the name for the class
    Class = "BgeeMetadata",
    
    # Define the slots
    representation = representation(
        intergenic_release = "character",
        all_releases = "list",
        intergenic_prefix = "character",
        fasta_intergenic_name = "character"
    ),
    
    prototype = prototype(
        intergenic_prefix = "intergenic_",
        fasta_intergenic_name = "bgee_intergenic.fa.gz"
    )
)


setMethod(
    f = "initialize",
    signature = "BgeeMetadata" ,
    definition = function(.Object, ...) {
        .Object <- callNextMethod()
        # do not download intergenic releases information when instantiation of BgeeMetadata with custom release.
        # Allows to run BgeeCall without internet connection when using intergenic sequences available localy.
        if(length(.Object@intergenic_release) != 0 && .Object@intergenic_release == "custom") {
            message("IMPORTANT : You decided to use your own reference intergenic sequences")
        } else {
            ## Get release information
            message("Querying Bgee to get intergenic release information...")
            allReleases <- listIntergenicReleases(removeFile = FALSE)
            # keep information of all available releases
            .Object@all_releases <- allReleases
            # if no release has been specified during instanciation
            # take more recent release
            if (length(.Object@intergenic_release) == 0) {
                .Object@intergenic_release <-
                    as.character(allReleases$release[1])
                message_to_users <-
                    as.character(allReleases$messageToUsers[1])
            } else if (length(.Object@intergenic_release) == 1) {
                if (.Object@intergenic_release %in% allReleases$release) {
                    .Object@intergenic_release <-
                        as.character(allReleases$release[allReleases$release ==
                            .Object@intergenic_release])
                    message_to_users <-
                        as.character(allReleases$messageToUsers[allReleases$release ==
                                                                    .Object@intergenic_release])
                } else {
                    stop(
                        "ERROR: The specified release number is invalid, or is not available for this version of BgeeCall."
                    )
                }
            } else {
                stop("ERROR: The specified release number is invalid.")
            }
            if (message_to_users != "") {
                message("IMPORTANT : ", message_to_users)
            }
        }
        validObject(.Object)
        .Object
    }
)

#' @title `intergenic_release` Setter
#'
#' @description Set value of the `intergenic_release` slot
#'
#' @param bgeeObject The BgeeMetadata object
#' @param intergenicRelease character corresponding to the `intergenic_release`
#'
#' @return An object of the class BgeeMetadata with new `intergenic_release`
#'  value
#'
#' @export
#' @docType methods
#' @rdname setIntergenicRelease
#'
#' @examples {
#' bgee <- new("BgeeMetadata")
#' bgee <- setIntergenicRelease(bgee, "0.1")
#' }
#'
setGeneric(
    name = "setIntergenicRelease",
    def = function(bgeeObject, intergenicRelease) {
        standardGeneric("setIntergenicRelease")
    }
)

#' @title `intergenic_release` Getter
#'
#' @description Get value of the `intergenic_release` slot
#'
#' @param bgeeObject The BgeeMetadata object
#'
#' @return the value of the `intergenic_release` slot of the object
#'
#' @export
#' @docType methods
#' @rdname getIntergenicRelease
#'
#' @examples {
#' bgee <- new("BgeeMetadata")
#' intergenic_release <- getIntergenicRelease(bgee)
#' }
#'
setGeneric(
    name = "getIntergenicRelease",
    def = function(bgeeObject) {
        standardGeneric("getIntergenicRelease")
    }
)

#' @title `intergenic_prefix` Getter
#'
#' @description Get value of the `intergenic_prefix` slot
#'
#' @param bgeeObject The BgeeMetadata object
#'
#' @return the value of the `intergenic_prefix` slot of the object
#'
#' @export
#' @docType methods
#' @rdname getIntergenicPrefix
#'
#' @examples {
#' bgee <- new("BgeeMetadata")
#' intergenic_prefix <- getIntergenicPrefix(bgee)
#' }
#'
setGeneric(
    name = "getIntergenicPrefix",
    def = function(bgeeObject) {
        standardGeneric("getIntergenicPrefix")
    }
)



#' @rdname setIntergenicRelease
#' @aliases setIntergenicRelease,bgeeMetadata,character
setMethod(
    f = "setIntergenicRelease",
    signature = c(bgeeObject = "BgeeMetadata",
    intergenicRelease = "character"),
    definition = function(bgeeObject, intergenicRelease) {
        releases <- as.data.frame(bgeeObject@all_releases)
        if (!(intergenicRelease %in% releases$release)) {
            stop(
                "Selected intergenic release does not exist.
Use function list_intergenic_release() to list all available releases."
            )
        }
        bgeeObject@intergenic_release <- intergenicRelease
        message_to_users <-
            as.character(releases$messageToUsers[releases$release ==
            intergenicRelease])
        if (message_to_users != "") {
            message("IMPORTANT : ", message_to_users)
        }
        return(bgeeObject)
    }
)

#' @rdname getIntergenicRelease
#' @aliases getIntergenicRelease,bgeeMetadata
setMethod(
    f = "getIntergenicRelease",
    signature = c(bgeeObject = "BgeeMetadata"),
    definition = function(bgeeObject) {
        return(bgeeObject@intergenic_release)
    }
)

#' @rdname getIntergenicPrefix
#' @aliases getIntergenicPrefix,bgeeMetadata
setMethod(
    f = "getIntergenicPrefix",
    signature = c(bgeeObject = "BgeeMetadata"),
    definition = function(bgeeObject) {
        return(bgeeObject@intergenic_prefix)
    }
)