R/idem_data.R

In idem: Inference in Randomized Controlled Trials with Death and Missingness

#' Create data for IDEM analysis
#'
#' Create a class \code{IDEMDATA} object for IDEM analysis
#'
#' @param data Original dataset
#'
#' @param trt Variable name for the Control (0) and Intervention (1) treatment
#'     assignments in the dataset
#'
#' @param surv Variable name for the survival (time to event) variable in the
#'     dataset
#'
#' @param outcome Chronologically ordered vector of variable names for clinical
#'     outcomes in the dataset excluding baseline
#'
#' @param y0 Variable name of the baseline clinical outcome
#'
#' @param cov Vector of variable names for the covariates used in the imputation
#'     procedure for missing clinical outcomes
#'
#' @param endfml \code{R} expression indicating the user-specified final outcome of
#'     interest. This is the function for \eqn{Z} of one or more of \eqn{Y_k}'s
#'
#' @param duration Length of the study. This is the time at which subjects' are
#'     assumed to be censored
#'
#' @param bounds Numeric vector of lower and upper bounds for subjects' imputed
#'     clinical outcomes
#'
#' @param trt.label label of the treatment arms
#'
#' @param unitTime Unit of time measurement for survival and function outcome time points
#'
#' @param err.terminate When there is error in the specification, the program
#'     should be stopped with an error message if err.terminate is true.
#'     Otherwise, the error message will be returned and the program will continue.
#'
#' @param ... Additional specifications
#'
#' @details
#'
#' When there are errors in the specification, i.e. \code{trt} is not a column
#' of \code{data}, a class \code{IDEMERROR} object will be returned. The
#' detailed errors can be checked by calling \code{print} of the
#' \code{IDEMERROR} object.
#'
#'
#' @return
#'
#'   When the specifications are correct, a class \code{IDEMDATA} list will be
#'   returned. The list contains
#'   \describe{
#'      \item{data}{Original dataset}
#'      \item{lst.var}{List of the specifications}}
#'
#' @examples
#' rst.data <- imData(abc, trt="TRT", surv="SURV", outcome=c("Y1","Y2"),
#'                    y0=NULL, endfml="Y2",
#'                    trt.label = c("UC+SBT", "SAT+SBT"),
#'                    cov=c("AGE"), duration=365, bounds=c(0,100));
#'
#' @export
#'
imData <- function(data, trt=NULL, surv=NULL, outcome=NULL, endfml=NULL,
                   y0 = NULL, cov = NULL,
                   duration = 9999, bounds = NULL, trt.label =NULL,
                   unitTime="days", err.terminate = TRUE, ...) {

    lst.var <- list(trt       = trt,
                    surv      = surv,
                    outcome   = outcome,
                    y0        = y0,
                    trt.label = trt.label,
                    cov       = cov,
                    endfml    = endfml,
                    duration  = duration,
                    bounds    = bounds,
                    unitTime  = unitTime);

    lst.var$parsed.endfml <- get.parsed.endfml(endfml);
    err.msg               <- chk.pars(data, lst.var);

    if (is.null(err.msg)) {
        if (is.null(lst.var$trt.label)) {
            trt.label <- sort(unique(data[,lst.var$trt]));
            trt.label <- sapply(trt.label, function(x) {
                if (0 == as.numeric(x)) {
                    return("Control");
                } else if (1 == as.numeric(x)) {
                    return("Intervention");
                } else
                    return(x);
            })
            lst.var$trt.label <- trt.label;
        }

        rst        <- list(data    = data,
                           lst.var = lst.var);
        class(rst) <- get.const("IDEM.CLASS");
    } else {

        if (err.terminate) {
            print(err.msg);
            stop("Please check the error messages above.", call. = FALSE);
        }

        rst <- err.msg;
    }

    invisible(rst)
}

#' Print error messages
#'
#' Print error messages in the parameter specifications generated by
#' \code{\link{imData}}
#'
#' @param x A class \code{IDEMERROR} object returned by
#'     \code{\link{imData}} when there are misspecifications
#' @param html Logical indicator for the format of the error messages. When \code{TRUE},
#'     the error messages are formatted in HTML format
#' @param ... Additional arguments
#'
#' @seealso \code{\link{imData}}
#'
#' @examples
#' \dontrun{
#' rst.data <- imData(abc, trt="TRT", outcome=c("Y1","Y2"), y0=NULL,
#'                    endfml="Y3", bounds=c(10,20), duration=365,
#'                    err.terminate=FALSE);
#' print(rst.data);}
#'
#' @export
#'
#'
print.IDEMERROR <- function(x, html = FALSE, ...) {
    msg.head <- "Model specification is invalid. Please check the following:";
    if (html) {
        rst <- paste(msg.head, "<ul><li>",
                     paste(x, collapse = "</li><li>"),
                     "</li></ul>");
    } else {
        rst <- paste(c(msg.head, x), collapse = "\n    ");
        rst <- paste(rst, "\n");
        cat(rst);
    }

    invisible(rst);
}

#' Print IDEMDATA object
#'
#' Print the specification details of class \code{IDEMDATA} objects generated by
#' \code{\link{imData}}
#'
#' @inheritParams print.IDEMERROR
#'
#' @param x A class \code{IDEMDATA} object generated by \code{\link{imData}}
#'
#' @seealso \code{\link{imData}}
#'
#' @export
#'
print.IDEMDATA <- function(x, ...) {
    data    <- x$data;
    lst.var <- x$lst.var;
    fcat <- function(...) {
        cat("    ", ..., "\n");
    }

    cat("There are", nrow(data), "observations of",
        ncol(data), "variables in the data. \n");
    cat("Detailed specifications are as follows: \n");
    fcat("Treatment:", lst.var$trt);
    fcat("Survival time:", lst.var$surv);
    fcat("Study duration:", lst.var$duration);
    fcat("Outcomes (ordered chronically):", lst.var$outcome);
    fcat("Endpoint (in R formula):", lst.var$endfml);
    if (!is.null(lst.var$y0))
        fcat("Baseline outcome:", lst.var$y0);
    if (!is.null(lst.var$trt.label))
        fcat("Treatment labels:", lst.var$trt.label);
    if (!is.null(cov))
        fcat("Covariates:", lst.var$cov);
    if (!is.null(lst.var$bounds))
        fcat("Biological boundary of the outcomes:", lst.var$bound);

    cat("\n\nSee summary information for missingness frequencies.", "\n")
}

#' Summary of IDEMDATA object
#'
#' Summarize the missing data information for class \code{IDEMDATA} objects
#' generated by \code{\link{imData}}.
#'
#' @param object A class \code{IDEMDATA} object returned by \code{\link{imData}}
#' @param opt Types of the summarization
#' \itemize{
#'
#' \item{\code{misstable}: }{Summarize the frequencies of each missing pattern}
#'
#' \item{\code{missid}: }{Summarize the indices of subjects that need
#'     imputation, i.e. survivors with functional endpoint missing}
#'
#' \item{\code{trt}: }{Treatment arms}
#' }
#'
#' @param endponly Logical variable that indicates whether clinical outcomes not
#'     used in calculating the functional outcome are considered as missing and
#'     should be imputed. The default is \code{FALSE}, indicating that all
#'     missing clinical outcomes will be imputed sequentially
#' @param ... Extra arguments
#'
#'
#' @return
#'
#' A dataframe with frequencies of each missing pattern when opt is \code{misstable}.
#'
#' A vector of indices of subjects that need imputation when opt is \code{missid}.
#'
#' A vector of treatment arms in the data when opt is \code{trt}.
#'
#' @seealso \code{\link{imData}}
#'
#' @method summary IDEMDATA
#'
#' @export
#'
#'
summary.IDEMDATA <- function(object,
                             opt = c("misstable", "missid", "trt"),
                             endponly=FALSE,
                             ...) {
    opt <- match.arg(opt);
    switch(opt,
           misstable = get.mis.table(object$data, object$lst.var),
           missid    = get.needimp(object$data, object$lst.var, endponly=endponly),
           trt       = sort(unique(object$data[,object$lst.var$trt])))
}

#' Plot of IDEMDATA object
#'
#' Generate different types of plots for class \code{IDEMDATA} objects.
#'
#' @inheritParams print.IDEMDATA
#'
#' @param opt Types of the plot
#'
#' \itemize{
#'
#' \item{\code{survivor: }}{Spaghetti plot for subjects alive at the end of the
#'     study}
#'
#' \item{\code{missing}: }{Plot the missing patterns of the observed data}
#'
#' \item{\code{KM}: }{Plot Kaplan-Meier survival curves}
#' }
#'
#' @param fname File name of the result pdf file. If \code{fname} is null,
#'     result pdf file will not be generated
#' @param cols Curve colors of the treatment and control arm for survival plot
#'     or colors of the observed and missing data for missingness plot.
#' @param ... Extra arguments for \code{plot}
#'
#' @seealso \code{\link{imData}}
#'
#' @examples
#' rst.data <- imData(abc, trt="TRT", surv="SURV", outcome=c("Y1","Y2"),
#'                  y0=NULL, endfml="Y2",
#'                  trt.label = c("UC+SBT", "SAT+SBT"),
#'                  cov=c("AGE"), duration=365, bounds=c(0,100));
#' plot(rst.data, opt = "survivor");
#' plot(rst.data, opt = "missing", cols = c("blue", "gray"));
#' plot(rst.data, opt = "KM");
#'
#' @method plot IDEMDATA
#'
#' @export
#'
#'
plot.IDEMDATA <- function(x, opt = c("survivor", "missing", "KM"),
                          cols = c("black", "blue"),
                          fname=NULL, ...) {

    opt <- match.arg(opt);
    switch(opt,
           survivor = plot.survivor(x$data, x$lst.var, fname=fname, ...),
           missing  = plot.mispattern(x$data, x$lst.var, fname=fname,
                                       cols=cols, ...),
           KM       = plot.surv(x$data, x$lst.var, fname=fname,
                                       cols=cols, ...))
}