## HAS_TESTS
#' @rdname counts-values-generator
#' @export
setMethod("Values",
signature(object = "array"),
function(object, dimtypes = NULL, dimscales = NULL) {
metadata <- MetaData(object = object,
dimtypes = dimtypes,
dimscales = dimscales)
object <- permuteToMatchIntervalOrPointMetadata(object, metadata = metadata)
object <- array(object@.Data,
dim = dim(metadata),
dimnames = dimnames(metadata))
methods::new("Values", object, metadata = metadata)
})
## HAS_TESTS
#' @rdname counts-values-generator
#' @export
setMethod("Values",
signature(object = "numeric"),
function(object, dimtypes = NULL, dimscales = NULL) {
name <- deparse(substitute(object))
dimnames <- list(names(object))
names(dimnames) <- name
object <- array(object,
dim = length(object),
dimnames = dimnames)
methods::callGeneric()
})
## HAS_TESTS
#' @rdname counts-values-generator
#' @export
setMethod("Values",
signature(object = "ANY"),
function(object, dimtypes = NULL, dimscales = NULL) {
object <- array(object,
dim = dim(object),
dimnames = dimnames(object))
methods::callGeneric()
})
## HAS_TESTS
#' @rdname counts-values-generator
#' @export
setMethod("Values",
signature(object = "DemographicArray"),
function(object, dimtypes = NULL, dimscales = NULL) {
.Data <- object@.Data
metadata <- object@metadata
new("Values", .Data = .Data, metadata = metadata)
})
## HAS_TESTS
#' @rdname countsone-valuesone
#' @export
ValuesOne <- function(values, labels, name, dimtype = NULL, dimscale = NULL) {
n.values <- length(values)
n.labels <- length(labels)
if (n.values < n.labels) {
if (n.labels %% n.values == 0L)
values <- rep(values, length.out = n.labels)
else
stop(gettextf("length of '%s' not a multiple of length of '%s'",
"labels", "values"))
}
else if (n.values > n.labels) {
stop(gettextf("length of '%s' greater than length of '%s'",
"values", "labels"))
}
if (!identical(length(name), 1L))
stop(gettextf("'%s' does not have length %d",
"name", 1L))
if (!is.null(dimtype) && !identical(length(dimtype), 1L))
stop(gettextf("'%s' does not have length %d",
"dimtype", 1L))
if (!is.null(dimscale) && !identical(length(dimscale), 1L))
stop(gettextf("'%s' does not have length %d",
"dimscale", 1L))
dimnames <- list(labels)
names(dimnames) <- name
object <- array(values, dim = n.labels, dimnames = dimnames)
if (is.null(dimtype))
dimtypes <- NULL
else
dimtypes <- structure(.Data = dimtype, names = name)
if (is.null(dimscale))
dimscales <- NULL
else
dimscales <- structure(.Data = dimscale, names = name)
Values(object, dimtypes = dimtypes, dimscales = dimscales)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.