R/S3deducorrect.R

In deducorrect: Deductive Correction, Deductive Imputation, and Deterministic Correction

#' deducorrect object
#'
#'
#' All \code{correct*} functions of the deducorrect package return an S3 object of class \code{deducorrect}.
#' The "public slots" are
#' \itemize{
#'  \item{\code{corrected} A copy of the input \code{data.frame}, with records corrected where possible.}
#'  \item{\code{corrections} A data.frame with the following colums:
#'  \itemize{    
#'      \item{\code{row} Row number where correction was applied}
#'      \item{\code{variable} Variable name where correction was applied} 
#'      \item{\code{old} Old value of adapted variable}
#'      \item{\code{new} New value of adapted variable}
#'  }}   
#'  \item{\code{status} A \code{data.frame} with the same number of rows as \code{corrected}. It has at least
#'  a column called \code{\link{status}}. Further columns might be present, depending on the used correction function.}
#'  \item{\code{generatedby} The name of the function that called \code{\link{newdeducorrect}} to construct the object.}
#'  \item{\code{timestamp} The time and date when the object was generated, as returned by \code{\link{date}}.}
#'  \item{\code{user} The system's username of the user running R. Note that this may yield unexpected results when R accessed on a remote (web)server.}
#' } 
#' 
#' 
#' @title deducorrect object 
#' 
#' 
#' @name deducorrect-object
#' @rdname deducorrect-object
{}





#' Generate an S3 \code{deducorrect} object
#' @aliases print.deducorrect
#' @param corrected The corrected data.frame
#' @param corrections A \code{data.frame} listing old and new values for every row and variable where corrections were applied
#' @param status A \code{data.frame} with at least one \code{\link{status}} column.
#' @param Call  Optionally, a \code{call} object.
#'
#' @return an S3 object of class \code{deducorrect}
#' 
#' @seealso \code{\link{deducorrect-object}}
newdeducorrect <- function(corrected, corrections, status, Call=sys.call(-1) ){ 
    if ( missing(corrections) ){
        corrections <- data.frame(
            row=numeric(0),
            variable=character(0),
            old=character(0),
            new=character(0)
        )
    }
    if (missing(status)){
        status <- data.frame(
            status = rep(NA,nrow(corrected))
        )
    }
    
    corrsummary <- array(0,dim=c(1,ncol(corrected)+1),dimnames=list(NULL,c(colnames(corrected),'sum'))) 
    if (nrow(corrections) > 0){
        corrsummary <- addmargins(table(corrections$variable, useNA="no"))
        rownames(corrections) <- NULL
    }

    structure(
        list(
            corrected   = corrected, 
            corrections = corrections, 
            status      = status,
            timestamp   = date(),
            call        = Call,
            generatedby = if ( is.list(Call) ) { Call[[1]][[1]] } else { Call[[1]] },
            user        = getUsername()
        ),
        class = c("deducorrect","list"),
        statsummary = addmargins(table(status$status, useNA="ifany")),
        corrsummary = corrsummary
    )
}

#' @method print deducorrect
#' @export
print.deducorrect <- function(x, ...){

    cat(paste(" deducorrect object generated by '", 
        x$generatedby, "'", " on ",x$timestamp, sep=""))
    cat(paste("\n slots: ",paste(paste("$",names(x),sep=""), collapse=", ")))
    
    cat("\n\n Record status:")  
    print(attr(x,"statsummary"))
    cat("\n Variables corrected:\n")
    print(attr(x,"corrsummary"))
}