R/metadataMethods.R

In jknowles/metaframe: Metadata for Dataframes

##' @title Print a summary of an \code{\linkS4class{meta.data}} object
##' @param x a \code{\linkS4class{meta.data}} object generated by \code{\link{document}}
##' @param ... optional additional parameters. 
##' @description Print out user-friendly view of meta.data
##' @return Values to the screen.
##' @note Not complete
##' @method print meta.data
##' @export
print.meta.data <- function(x, ...){
  cat(paste0("Showing metadata for object:  ", x@Rname))
  cat("\n ------------------------------------------------------------- \n")
  cat("Showing metadata for following variables in object: \n",
  paste(paste(names(x@labels), unlist(x@labels), sep=" : "), "\n"), "\n")
  cat("---------------------------------------------------------------- \n")
  cat("Data from following sources: \n", 
      paste(paste(names(x@sources), unlist(lapply(x@sources, "[", "Citation")), 
                  sep=" : "), "\n"), "\n")
  cat("---------------------------------------------------------------- \n")
  cat("Data expressed in the following units: \n", 
      paste(paste(names(x@units), unlist(x@units), sep=" : "), "\n"), "\n")
  cat("---------------------------------------------------------------- \n")
  cat("Additional notes on the data: \n", 
      paste(paste(names(x@notes), unlist(x@notes), sep=" : "), "\n"), "\n")
  cat("---------------------------------------------------------------- \n")
  cat("Revision history for data elements: \n", 
      paste(paste(names(x@revisions), unlist(x@revisions), sep=" : "), "\n"), "\n")
  cat("---------------------------------------------------------------- \n")
  }

#' @title Summarize a meta.data
#' @description This is a function to summarize a meta.data
#' @param object An object of class meta.data
#' @param ... ignored
#' @method summary meta.data
#' @export
summary.meta.data <- function(object, ...){
  # build a table and test for completeness of meta.data
  # rows are variables
  # columns are meta.data elements
  cols <- c("units", "labels", "sources","notes", "revisions")
  rows <- c(names(object@units))
  sumTab <- matrix(nrow = length(rows), ncol = length(cols))
  sumTab <- as.data.frame(sumTab); colnames(sumTab) <- cols
  rownames(sumTab) <- rows
  sumTab$labels <- length(nchar(unlist(object@labels)) > 5)
  sumTab$units <- length(nchar(unlist(object@units)) > 3)
  sumTab$notes <- length(nchar(unlist(object@notes)) > 5)
  sumTab$revisions <- length(nchar(unlist(object@revisions)) > 5)
  sumTab$sources <- length(nchar(unlist(lapply(object@sources, "[", "Citation"))) > 10)
  
  structure(list(sumTab = sumTab, 
                 compPercent = apply(sumTab, 2, function(x) mean(as.numeric(x))) 
                 ), class = "summary.meta.data")
}

#' @title Print a meta.data summary
#' @description This is a function to summarize a meta.data
#' @param x An object of class summary.meta.data
#' @param ... ignored
#' @method print summary.meta.data
#' @export
print.summary.meta.data <- function(x, ...){
  cat("** Completeness of meta.data for object ** \n")
  cat("----------------------------------------\n")
  cat("Percentage of meta.data complete: \n")
  print(round(x$compPercent * 100, 3))
  cat("----- \n")
  cat("Complete elements by column: \n")
  print(x$sumTab)
}

#' @title Display the structure of a meta.data object
#' @description This is a function to display the internal structure of a meta.data
#' @param object An object of class meta.data
#' @param ... ignored
#' @method str meta.data
#' @export
str.meta.data <- function(object, ...){
  nameList <- slotNames(object)
  cat("Object of class meta.data with slots: \n")
  for(i in nameList){
    tmp <- slot(object, i)
    string1 <- paste0(i, " a ", class(tmp), " of length ", 
                     length(tmp), ": ")
    if(i != "sources"){
#       cat(paste0(string1, " \n      ", 
#                  paste0(strtrim(unlist(tmp[1:5]), 10), collapse = " ..., "), " \n"))
      cat(string1)
      cat("\n")
      str(tmp)
    } else{
      cat(string1)
      str(tmp)
    }
  }
}