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
|
#' Save R-level metadata to disk
#'
#' Save \code{\link{metadata}} and \code{\link{mcols}} for \linkS4class{Annotated} or \linkS4class{Vector} objects, respectively, to disk.
#' These are typically used inside \code{\link{saveObject}} methods for concrete subclasses.
#'
#' @param x A \linkS4class{Vector} or \linkS4class{Annotated} object.
#' @param metadata.path String containing the path in which to save the \code{metadata}.
#' If \code{NULL}, no \code{\link{metadata}} is saved.
#' @param mcols.path String containing the path in which to save the \code{mcols}.
#' If \code{NULL}, no \code{\link{mcols}} is saved.
#' @param ... Further arguments to be passed to \code{\link{altSaveObject}}.
#'
#' @author Aaron Lun
#'
#' @return
#' The metadata for \code{x} is saved to \code{metadata.path}, and similarly for the \code{mcols}.
#'
#' @details
#' If \code{mcols(x)} has no columns, nothing is saved by \code{saveMcols}.
#' Similarly, if \code{metadata(x)} is an empty list, nothing is saved by \code{saveMetadata}.
#' This avoids creating unnecessary files with no meaningful content.
#'
#' If \code{mcols(x)} has non-\code{NULL} row names, these are removed prior to staging.
#' These names are usually redundant with the names associated with elements of \code{x} itself.
#'
#' @seealso
#' \code{\link{readMetadata}}, which restores metadata to the object.
#'
#' @export
#' @aliases .processMetadata .processMcols processMetadata processMcols
#' @importFrom S4Vectors metadata
saveMetadata <- function(x, metadata.path, mcols.path, ...) {
if (!is.null(metadata.path)) {
mm <- metadata(x)
if (!is.null(mm) && length(mm)) {
tryCatch({
altSaveObject(mm, metadata.path, ...)
}, error=function(e) stop("failed to stage 'metadata(<", class(x)[1], ">)'\n - ", e$message))
}
}
if (!is.null(mcols.path)) {
mc <- mcols(x, use.names=FALSE)
if (!is.null(mc) && ncol(mc)) {
rownames(mc) <- NULL # stripping out unnecessary row names.
output <- tryCatch({
altSaveObject(mc, mcols.path, ...)
}, error=function(e) stop("failed to stage 'mcols(<", class(x)[1], ">)'\n - ", e$message))
}
}
}
#######################################
########### OLD STUFF HERE ############
#######################################
#' @export
#' @importFrom S4Vectors metadata
processMetadata <- function(x, dir, path, meta.name) {
if (!is.null(meta.name) && length(metadata(x))) {
tryCatch({
meta <- altStageObject(metadata(x), dir, paste0(path, "/", meta.name), child=TRUE)
list(resource=writeMetadata(meta, dir=dir))
}, error=function(e) stop("failed to stage 'metadata(<", class(x)[1], ">)'\n - ", e$message))
} else {
NULL
}
}
#' @export
#' @importFrom S4Vectors mcols
processMcols <- function(x, dir, path, mcols.name) {
output <- NULL
if (!is.null(mcols.name)) {
mc <- mcols(x, use.names=FALSE)
if (!is.null(mc) && ncol(mc)) {
rownames(mc) <- NULL # stripping out unnecessary row names.
output <- tryCatch({
meta <- altStageObject(mc, dir, paste0(path, "/", mcols.name), child=TRUE)
list(resource=writeMetadata(meta, dir=dir))
}, error=function(e) stop("failed to stage 'mcols(<", class(x)[1], ">)'\n - ", e$message))
}
}
return(output)
}
# Soft-deprecated back-compatibility fixes
#' @export
.processMetadata <- function(...) processMetadata(...)
#' @export
.processMcols <- function(...) processMcols(...)
|
