R/summary_kb.R

In Keyboard: Bayesian Designs for Early Phase Clinical Trials

#' Summarize Objects Generated by the Keyboard Design Package
#'
#' This function generates a descriptive summary for objects returned by other functions.\cr
#'
#' Unpacks objects returned by other functions with descriptions of
#' their results. The following functions are supported:\cr
#' (1) get.oc.kb(), get.oc.comb.kb(), get.oc.obd.kb(), and get.oc.obd2.kb(), which yield the operating
#'     characteristics of trials simulated using the Keyboard design.\cr
#' (2) select.mtd.kb() and select.mtd.comb.kb(), which yield the MTD and other
#'     statistics.\cr
#' (3) next.comb.kb(), which indicates the dose combination to administer to
#'     the next cohort. \cr
#' (4) select.obd.kb(), which yields the OBD.
#'
#' @param object The object (returned by another function) to be described.
#' @param ... Ignored arguments.
#'
#' @return This function helps users to interpret the objects returned by other
#'   Keyboard package functions.
#' @import Rcpp methods graphics stats
#' @export
#' @author Xiaomeng Yuan, Chen Li, Hongying Sun, Li Tang and Haitao Pan
#' @examples
#' \donttest{
#' ### Single-agent trial ###
#'
#' ## Summarize the object returned by get.oc.kb()
#' oc.single <- get.oc.kb(target=0.3, p.true=c(0.05, 0.15, 0.3, 0.45, 0.6),
#'                        ncohort=10, cohortsize=3, ntrial=1000)
#' summary_kb(oc.single)
#'
#'
#' ## Summarize the object returned by select.mtd.kb()
#' n <- c(3, 3, 15, 9, 0)
#' y <- c(0, 0, 4, 4, 0)
#' sel.single <- select.mtd.kb(target=0.3, npts=n, ntox=y)
#' summary_kb(sel.single)
#'
#'
#'
#' ## Summarize the object returned by select.mtd.comb.kb()
#' n <- matrix(c(6, 3, 0, 0,
#'               6, 24, 9, 0,
#'               0, 0, 0, 0), ncol=4, byrow=TRUE)
#' y <- matrix(c(0, 0, 0, 0,
#'               1, 5, 4, 0,
#'               0, 0, 0, 0), ncol=4, byrow=TRUE)
#' sel.comb <- select.mtd.comb.kb(target=0.25, npts=n, ntox=y)
#' summary_kb(sel.comb)
#'
#'
#' ## Summarize the object returned by next.comb.kb()
#' n <- matrix(c(3, 0, 0, 0,
#'               0, 0, 0, 0,
#'               0, 0, 0, 0), ncol=4, byrow=TRUE)
#' y <- matrix(c(0, 0, 0, 0,
#'               0, 0, 0, 0,
#'               0, 0, 0, 0), ncol=4, byrow=TRUE)
#' nxt.comb <- next.comb.kb(target=0.25, npts=n, ntox=y, dose.curr=c(1, 1))
#' summary_kb(nxt.comb)
#'
#' ## get.oc.obd
#' toxicity.low <- 0.15
#' toxicity.moderate <- 0.25
#' toxicity.high <- 0.35
#' efficacy.low <- 0.25
#' efficacy.moderate <- 0.45
#' efficacy.high <- 0.65
#' target.toxicity<-0.20
#' target.efficacy<-0.40
#' p.true <-c(0.08,0.20,0.60,0.80)
#' q.true <- c(0.25,0.40,0.25,0.50)
#' oc.obd.kb <- get.oc.obd.kb(toxicity.low = toxicity.low,
#'              toxicity.moderate= toxicity.moderate,
#'              toxicity.high = toxicity.high,
#'              efficacy.low = efficacy.low,
#'              efficacy.moderate = efficacy.moderate,
#'              efficacy.high = efficacy.high,
#'              target.toxicity=target.toxicity,
#'              target.efficacy= target.efficacy,
#'              p.true= p.true, q.true= q.true)
#' summary_kb(oc.obd.kb)
#'
#' ## OBD selection
#' target.toxicity<-0.3
#' target.efficacy<-0.4
#' npts <- c(3,6,12,3,3)
#' ntox <-  c(1,2,4,2,3)
#' neff <-  c(0,0,5,1,1)
#' obd <- select.obd.kb (target.toxicity=target.toxicity,
#'        target.efficacy= target.efficacy, npts = npts,
#'        ntox = ntox, neff =  neff)
#' summary_kb(obd)
#' }
#'
#' @seealso \code{\link{plot_kb}}
#'

summary_kb <- function(object, ...) {
  # UseMethod("summary_kb")
  ### next.comb.kb()
  if (!is.null(object$next_dc)) {
    if (is.na(object$next_dc[1]) == TRUE) {
      cat("The trial experienced an early stopping.")
    }
    else {
      cat("The recommended dose combination for the next cohort of patients is (", object$next_dc[1], ", ", object$next_dc[2], ").", "\n")
    }
  }

  ### select.mtd.kb()
  if (!is.null(object$MTD)) {
    if (length(object$MTD) == 1) { ## select.mtd.kb()
      if (object$MTD==99) {
        cat("All tested doses are overly toxic. No MTD should be selected! \n\n")
      }
      else {
        cat("The MTD is dose level ",object$MTD, "\n\n")
      }
      cat("Dose    Posterior DLT             95%                  \n", sep="")
      cat("Level     Estimate         Credible Interval   Pr(toxicity>", object$target, "|data)\n", sep="")
      for (i in 1:nrow(object$p_est)) {
        cat(" ", i, "        ", as.character(object$p_est[i,2]),
            "         ", as.character(object$p_est[i,3]),
            "         ", as.character(object$p_overdose[i]), "\n")
      }
      cat("NOTE: no estimate is provided for the doses at which no patient was treated.\n")
    }

    else if (length(object$MTD) >= 2) { ## select.mtd.comb.kb()
      if (length(object$MTD) == 2) {
        if (object$MTD[1,1] == 99 && object$MTD[1,2] == 99) {
          cat("All tested doses are overly toxic. No MTD is selected! \n")
        }
        else {
          cat("The MTD is dose combination (", object$MTD[1,1], ", ", object$MTD[1,2], ") \n\n")
        }
      }
      else {
        if (length(object$MTD) == 0) {
          cat("All tested doses are overly toxic. No MTD is selected! \n")
        }
        #else{
        #  cat("The MTD contour includes dose combinations ",
        #      paste('(', object$MTD[,1], ", ", object$MTD[,2],')', sep=''), "\n\n")
        #}
      }

      cat("Isotonic estimates of toxicity probabilities for combinations are \n")
      for (i in 1:dim(object$p_est)[1]) {
        cat(formatC(object$p_est[i,], digits=2, format="f", width=5), sep="  ", "\n")
      }
      cat("\n")
      cat("NOTE: no estimate is provided for the doses at which no patient was treated.\n\n")
    }
  }

  ### get.oc.kb()
  ## 'percentstop' comes from the get.oc.kb() function, so object passed must
  ##   have been generated by that function.
  if (!is.null(object$percentstop)) {
    cat("selection percentage at each dose level (%):\n")
    cat(formatC(object$selpercent, digits=1, format="f"), sep="  ", "\n")

    cat("average number of patients treated at each dose level:\n")
    cat(formatC(object$npatients, digits=1, format="f"), sep ="  ", "\n")

    cat("average number of toxicity observed at each dose level:\n")
    cat(formatC(object$ntox, digits=1, format="f"), sep ="  ", "\n")

    cat("average number of toxicities:",
        formatC(object$totaltox, digits=1, format="f"), "\n")
    cat("average number of patients:",
        formatC(object$totaln, digits=1, format="f"), "\n")

    cat("percentage of early stopping due to toxicity:",
        formatC(object$percentstop, digits=1, format="f"), "\b% \n")
    if (!is.null(object$overdose60)) {
      #cat("risk of poor allocation:", formatC(object$poorallocation, digits=1, format="f"), "% \n")
      cat("risk of overdosing (>60% of patients treated above the MTD):",
          formatC(object$overdose60, digits=1, format="f"), "\b% \n")
      cat("risk of overdosing (>80% of patients treated above the MTD):",
          formatC(object$overdose80, digits=1, format="f"), "\b% \n")
    }
  }

  ### get.oc.comb.kb() (no MTD contour)
  if(!is.null(object$name) && object$name == "get.oc.comb.kb") {
    cat("true DLT rate of dose combinations:\n")
    for (i in 1:dim(object$p.true)[1]) {
      cat(formatC(object$p.true[i,], digits = 2, format = "f", width = 5),
          sep = "  ", "\n")
    }
    cat("\n")
    cat("selection percentage at each dose combination (%):\n")
    for (i in 1:dim(object$p.true)[1]) {
      cat(formatC(object$selpercent[i,], digits = 2, format = "f", width = 5),
          sep = "  ", "\n")
    }
    cat("\n")
    cat("average number of patients treated at each dose combination:\n")
    for (i in 1:dim(object$p.true)[1]) {
      cat(formatC(object$nptsdose[i,], digits = 2, format = "f", width = 5),
          sep = "  ", "\n")
    }
    cat("\n")
    cat("average number of toxicity observed at each dose combination:\n")
    for (i in 1:dim(object$p.true)[1]) {
      cat(formatC(object$ntoxdose[i,], digits = 2, format = "f", width = 5),
          sep = "  ", "\n")
      ## In BOIN package, 'ntoxdose' is 'ntox'
    }
    cat("\n")
    cat("average number of toxicities:",
        formatC(object$totaltox, digits = 1, format ="f"), "\n")
    cat("average number of patients:",
        formatC(object$totaln, digits =1, format = "f"), "\n")
    cat("selection percentage of MTD:",
        formatC(object$pcs, digits = 1, format = "f"), "\n")
    cat("percentage of patients treated at MTD:",
        formatC(object$npercent, digits =1, format = "f"), "\n") #gail

    #cat("percentage of early stopping due to toxicity:", formatC(object$pes, digits = 2, format = "f"), "\n") #gail
  }

  ### get.oc.obd.kb()
  if(!is.null(object$name) && object$name == "get.oc.obd.kb"){
    cat("selection percentage at each dose level (%) using utility function 1:\n")
    cat(formatC(object$selpercent1, digits=1, format="f"), sep="  ", "\n")

    cat("selection percentage at each dose level (%) using utility function 2:\n")
    cat(formatC(object$selpercent2, digits=1, format="f"), sep="  ", "\n")

    cat("selection percentage at each dose level (%) using utility function 3:\n")
    cat(formatC(object$selpercent3, digits=1, format="f"), sep="  ", "\n")

    cat("average number of patients treated at each dose level:\n")
    cat(formatC(object$npatients, digits=1, format="f"), sep ="  ", "\n")

    cat("average number of toxicity observed at each dose level:\n")
    cat(formatC(object$ntox, digits=1, format="f"), sep ="  ", "\n")

    cat("average number of efficacies observed at each dose level:\n")
    cat(formatC(object$neff, digits=1, format="f"), sep ="  ", "\n")

    cat("average number of toxicities:",
        formatC(object$totaltox, digits=1, format="f"), "\n")

    cat("average number of efficacies:",
        formatC(object$totaleff, digits=1, format="f"), "\n")

    cat("average number of patients:",
        formatC(object$totaln, digits=1, format="f"), "\n")

    cat("percentage of early stopping due to toxicity:",
        formatC(object$earlystop, digits=1, format="f"), "\b% \n")

    cat("percentage of trial termination using utility function 1:",
        formatC(object$percentstop1, digits=1, format="f"), "\b% \n")
    cat("percentage of trial termination using utility function 2:",
        formatC(object$percentstop2, digits=1, format="f"), "\b% \n")
    cat("percentage of trial termination using utility function 3:",
        formatC(object$percentstop3, digits=1, format="f"), "\b% \n")

  }

  ### select.obd.kb()
  if(!is.null(object$name) && object$name == "select.obd.kb"){
   if (object$obd1==99) {
        cat("All tested doses are overly toxic. No MTD should be selected using utility function 1 ! \n\n")
      }
      else {
        cat("The OBD is dose level using utility function 1  ",object$obd1, "\n\n")
      }
       if (object$obd2==99) {
        cat("All tested doses are overly toxic. No MTD should be selected using utility function 2 ! \n\n")
      }
      else {
        cat("The OBD is dose level using utility function 2 ",object$obd2, "\n\n")
      }
       if (object$obd3==99) {
        cat("All tested doses are overly toxic. No MTD should be selected using utility function 3 ! \n\n")
      }
      else {
        cat("The OBD is dose level using utility function 3  ",object$obd3, "\n\n")
      }
  }
}