##' Generic function to build a meta.data object
##'
##' Define and describe meta.data for a data object in R. Based on the object
##' structure this function will automatically define some attributes of the data.
##' @param data a data object to define metadata for
##' @param metadata a meta.data object to use for documentation
##' @param sources a list of charcter strings describing data sources
##' @param units a list of character strings describing units for the columns
##' @param labels a list of character strings providing long variable names and labels
##' @param notes a list of character strings with additional notes about variables
##' @param revisions a list of character strings with information about revisions to a variable
##' @param ... optional additional parameters to \code{meta.data.summary}
##' @return A \code{\linkS4class{meta.data}} object
##' @details
##' The object has the following items
##' \itemize{
##' \item{sources - a list of character strings describing data sources}
##' \item{units - a list of character strings specifying the units of variables}
##' \item{labels - a generic character string describing an object}
##' \item{notes - character strings describing any additional details about specific data elements}
##' \item{revisions - a list of data revisions}
##' }
##' @note Yadda yadda yadda
##' @export document
##' @rdname document
##' @author Jared E. Knowles
document <- function(data, metadata = NULL, sources = NULL, units=NULL,
labels=NULL, notes=NULL, revisions=NULL, ...){
UseMethod("document")
}
#' @title Setting meta.data from a data.frame object
#' @rdname document
#' @method document data.frame
#' @export
document.data.frame <- function(data, metadata = NULL, sources = NULL, units=NULL,
labels=NULL, notes=NULL,
revisions=NULL, ...){
if (!is.data.frame(data)) stop("data must be a data.frame")
if(!is.null(metadata)){
stopifnot(class(metadata) == "meta.data")
newdata <- data
attr(newdata, "meta.data") <- metadata
class(newdata) <- c("metaframe", "data.frame")
return(newdata)
}
K <- ncol(data) + 1
if(is.null(sources)){
srcList <- vector(mode = "list", length = 4)
names(srcList) <- c("Name", "Year", "Citation", "Notes")
sources <- rep(list(srcList), K)
names(sources) <- c("OVERALL", colnames(data))
} else if(class(sources) != "list"){
sources <- as.list(sources)
}
if(is.null(labels)){
labels <- vector(mode = "list", length = K)
names(labels) <- c("OVERALL", colnames(data))
} else if(class(labels) != "list"){
labels <- as.list(labels)
}
if(is.null(notes)){
notes <- list("No notes listed.")
} else if(class(notes) != "list"){
notes <- as.list(notes)
}
if(is.null(revisions)){
revisions <- list("No revisions listed.")
} else if(class(revisions) != "list"){
revisions <- as.list(revisions)
}
if(is.null(units)){
units <- vector(mode = "list", length = K-1)
names(units) <- colnames(data)
} else if(class(units) != "list"){
units <- as.list(units)
}
# check for additional values
args <- eval(substitute(alist(...))) # get ellipsis values
args <- lapply(args, eval, parent.frame()) # convert from symbols to objects
if(exists("n", args)){
n <- args$n
} else{
n <- 5
}
outMD <- meta.data(sources = sources,
units = units,
labels = labels,
notes = notes,
revisions = revisions,
var_names = colnames(data),
obs_names = rownames(data),
summary = meta.summary(data, n = n),
Rname = deparse(substitute(data)))
newdata <- data
attr(newdata, "meta.data") <- outMD
class(newdata) <- c("metaframe","data.frame")
return(newdata)
}
#' @title Setting meta.data from a data.table object
#' @rdname document
#' @method document data.table
#' @export
document.data.table <- function(data, metadata = NULL, sources = NULL, units=NULL,
labels=NULL, notes=NULL,
revisions=NULL, ...){
if (class(data) != "data.table") stop("data must be a data.table")
if(!is.null(metadata)){
stopifnot(class(metadata) == "meta.data")
newdata <- data
attr(newdata, "meta.data") <- metadata
class(newdata) <- c("metaframe", "data.table")
return(newdata)
}
K <- ncol(data) + 1
if(is.null(sources)){
srcList <- vector(mode = "list", length = 4)
names(srcList) <- c("Name", "Year", "Citation", "Notes")
sources <- rep(list(srcList), K)
names(sources) <- c("OVERALL", colnames(data))
} else if(class(sources) != "list"){
sources <- as.list(sources)
}
if(is.null(labels)){
labels <- vector(mode = "list", length = K)
names(labels) <- c("OVERALL", colnames(data))
} else if(class(labels) != "list"){
labels <- as.list(labels)
}
if(is.null(notes)){
notes <- list("No notes listed.")
} else if(class(notes) != "list"){
notes <- as.list(notes)
}
if(is.null(revisions)){
revisions <- list("No revisions listed.")
} else if(class(revisions) != "list"){
revisions <- as.list(revisions)
}
if(is.null(units)){
units <- vector(mode = "list", length = K-1)
names(units) <- colnames(data)
} else if(class(units) != "list"){
units <- as.list(units)
}
# check for additional values
args <- eval(substitute(alist(...))) # get ellipsis values
args <- lapply(args, eval, parent.frame()) # convert from symbols to objects
if(exists("n", args)){
n <- args$n
} else{
n <- 5
}
outMD <- meta.data(sources = sources,
units = units,
labels = labels,
notes = notes,
revisions = revisions,
var_names = colnames(data),
obs_names = rownames(data),
summary = meta.summary(data, n = n),
Rname = deparse(substitute(data)))
newdata <- data
attr(newdata, "meta.data") <- outMD
class(newdata) <- c("metaframe", "data.table")
return(newdata)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.