R/print.titesim_ss.R

In elizabethchase/seamlesssim: Simulates Seamless Phase I/II Oncology Trials

#' S3 print method for titesim_ss
#'
#' print.titesim_ss prints the results from titesim_ss, the simulator function
#' for a tite-crm trial.
#'
#' @param x An object of type titesim_ss, outputted from titesim_ss.
#' @param dgt Number of digits for output rounding. Default value is 3.
#' @param patient.detail Should patient-level information be provided, or only summary data?  Default is patient-level,
#' indicated by TRUE. For only summary data, use FALSE.
#' @param ... List of additional arguments. Currently the following are implemented:
#' @return Printed output from titesim_ss.
#' @references
#'
#' \insertRef{boonstra2020}{seamlesssim}
#'
#' \insertRef{dfcrm2019}{seamlesssim}
#'
#' @import dfcrm
#' @export
print.titesim_ss = function (x, ...)
{

  args = list(...)
  if ("dgt" %in% names(args)){
  dgt = args$dgt
  } else (dgt <- 3)
  if ("patient.detail" %in% names(args)){
    dgt = args$patient.detail
  } else (patient.detail <- TRUE)

  if (x$all_sim$nsim == 1) {
    x = x$last_sim
    n.enrolled = n = x$n.enrolled;
    PI <- x$PI
    prior <- round(x$prior, digits = dgt)
    target <- x$target
    K <- length(prior)
    y <- x$tox
    level <- x$level
    bethat <- signif(x$beta.hat, digits = 1)
    est <- round(x$final.est, digits = dgt)
    ptox <- round(x$ptox, digits = dgt)
    ptoxL <- round(x$ptoxL, digits = dgt)
    ptoxU <- round(x$ptoxU, digits = dgt)
    if (patient.detail) {
      if (x$tite) {
        arrival <- signif(x$arrival, digits = dgt)
        utox <- round(x$toxicity.study.time, digits = dgt)
        u <- round(x$toxicity.time, digits = dgt)
        tevent <- round(c(arrival, utox), digits = dgt)
        pid <- rep(1:n, 2)
        event <- c(rep("enrol", n), rep("TOX", n))
        level2 <- c(level, level)
        est2 <- round(c(bethat, rep(NA, n)), digits = dgt)
        o <- order(tevent)
        tevent <- tevent[o]
        pid <- pid[o]
        event <- event[o]
        level2 <- level2[o]
        est2 <- est2[o]
        ind <- which(tevent < Inf)
        tevent <- tevent[ind]
        pid <- pid[ind]
        event <- event[ind]
        level2 <- level2[ind]
        est2 <- est2[ind]
        m <- length(ind)
        cat("Trial summary on study time\n")
        cat("Time \t PID \t Event \t Level \t Beta \n")
        for (j in 1:m) {
          cat(tevent[j], "\t", pid[j], "\t", event[j],
              "\t", level2[j], "\t", est2[j], "\n")
        }
        cat("\nPatient summary (TITE-CRM) \n")
        cat("PID \t Arrive \t Beta \t Level \t Tox \t Tox.time \n")
        for (i in 1:n) {
          cat(i, "\t", arrival[i], "\t\t", bethat[i],
              "\t", level[i], "\t", y[i], "\t", u[i], "\n")
        }
      }
      else {
        cat("Patient summary (CRM) \n")
        cat("PID", "\t", "Beta", "\t", "Level", "\t",
            "Toxicity", "\n")
        for (i in 1:n) {
          cat(i, "\t", bethat[i], "\t", level[i], "\t",
              y[i], "\n")
        }
      }
    }
    cat("\nToxicity probability summary (with", x$conf.level *
          100, "percent probability interval):", "\n")
    cat("Level", "\t", "Ptrue", "Prior", "\t", "n", "\t",
        "ntox", "\t", "Posterior", "\t", "LoLmt", "\t", "UpLmt",
        "\n")
    ntox <- nexpt <- rep(0, K)
    for (k in 1:K) {
      nexpt[k] <- length(which(level == k))
      ntox[k] <- length(which(level == k & y == 1))
      cat(k, "\t", PI[k], "\t", prior[k], "\t", nexpt[k],
          "\t", ntox[k], "\t", ptox[k], "\t\t", ptoxL[k],
          "\t", ptoxU[k], "\n")
    }
    PIjit <- PI
    PIjit[1] <- PI[1] - (1e-05)
    PIjit[K] <- PI[K] + (1e-05)
    cat("True MTD:", order(abs(PIjit - target))[1], "\tEstimated MTD:",
        x$MTD, "\tTarget DLT rate:", target, "\n")
    cat("\nThis trial is generated by a", x$design, "\n")
    if (length(x$x0) > 1) {
      cat("Dose escalation proceeds as follows before any toxicity is seen:")
      xtab <- cbind(1:K, rep(NA, K))
      for (k in 1:K) {
        xtab[k, 2] = length(which(x$x0 == k))
      }
      colnames(xtab) <- c("dose.level", "cohort.size")
      rownames(xtab) <- rep("", K)
      print(t(xtab))
    }
    if (x$restrict) {
      ###Begin Phil's modification
      cat("\nSafety constraints implemented:\n")
      cat("\t (1) No skipping doses in escalation;\n")
      cat("\t (2) No escalation before followup of",x$followup_b4_esc, " on at least one patient at current or larger dose.\n")
      cat("\t (3) No assignment to dose with estimated DLT rate beyond ", x$no.exceed + x$target, ".\n",sep="")
      cat("\t (4) Stopping trial altogether if at any point after patient ", x$earliest_stop," the estimated DLT rate at all dose levels exceeds ", x$no.exceed + x$target, ".\n",sep="")
    }
    if(x$first.cohort.only) {
      cat("\nThe first", x$cohort.size, "patients were enrolled at the starting dose level, with patients assigned individually thereafter")
    } else {
      cat("\nPatients were enrolled in cohorts of", x$cohort.size)
    }
    if (x$stop.for.tox>0) {
      cat("\n-->IMPORTANT: At patient ", x$stop.for.tox, ", the lowest dose had an estimated toxicity rate \n\texceeding the pre-specified safety bound of ",x$no.exceed + x$target,", and the trial stopped. Final estimates of toxicity correspond to the patient immediately prior\n",sep="");
    }
    ###End Phil's modification
    cat("\nThe working model is", x$model, "\n")
    if (x$model == "empiric") {
      cat("\tptox = dose^{exp(beta)} with doses =", round(x$dosescaled,
                                                          digits = dgt), "\n")
    }
    else {
      cat("\tlogit(ptox) = a + exp(beta)*dose, with a =",
          x$intcpt, "\n\tand doses =", signif(x$dosescaled,
                                              digits = dgt), "\n")
    }
    if (x$method == "bayes") {
      cat("\tand beta is estimated by its posterior mean \n\tassuming a normal prior with mean 0 and variance",
          x$prior.var, "\n")
    }
    else if (x$method == "mle") {
      cat("\tand beta is estimated by its mle\n")
    }
    cat("\nThe final estimate of beta", round(x$final.est,
                                              digits = dgt))
    if (x$method == "bayes") {
      cat(" with posterior variance", round(x$post.var,
                                            digits = dgt), "\n")
    }
    else if (x$method == "mle") {
      cat(" with variance", round(x$post.var, digits = dgt),
          "\n")
      if (x$msg != "Okay") {
        print(x$msg)
      }
    }
    if (x$tite) {
      cat("\nThe", x$scheme, "function is used to assign weights to patients, using parameters\n",unlist(x$scheme_args),".\n\n")
      cat("Patient arrival is modeled as a", x$accrual,
          "process\n")
      cat("\twith rate", x$rate, "patients per", x$obswin,
          "time units (= observation window).\n")
      if (length(x$x0) > 1) {
        cat("\tA minimum waiting time of", x$tgrp, "time units is imposed\n")
        cat("\tbetween two dose cohorts in the initial stage.\n")
      }
    }
  } else {
    x = x$all_sim
    n.success <- mean(x$n.enrolled[which(x$stop.for.tox==0)]);
    n.fail <- mean(x$n.enrolled[which(x$stop.for.tox>0)]);
    PI <- x$PI
    prior <- round(x$prior, digits = dgt)
    target <- x$target
    K <- length(prior)
    oc <- t(cbind(PI, prior, x$MTD[-1], x$level, x$tox))
    colnames(oc) <- as.character(1:K)
    rownames(oc) <- c("Truth", "Prior", "Selected", "Nexpt",
                      "Ntox")
    cat("\nNumber of simulations:\t", x$nsim, "\n")
    cat("Patients accrued in successfully completed trials:\t", n.success, "\n")
    cat("Patients accrued in trials stopped for toxicity:\t", n.fail, "\n")
    cat("Target DLT rate:\t", target, "\n")
    print(round(oc, digits = dgt))
    if (x$tite) {
      cat("\nThe distribution of trial duration:\n")
      print(summary(x$Dur))
    }
    cat("\nThe trials are generated by a", x$design, "\n")
    if (length(x$x0) > 1) {
      cat("Dose escalation proceeds as follows before any toxicity is seen:")
      xtab <- cbind(1:K, rep(NA, K))
      for (k in 1:K) {
        xtab[k, 2] = length(which(x$x0 == k))
      }
      colnames(xtab) <- c("dose.level", "cohort.size")
      rownames(xtab) <- rep("", K)
      print(t(xtab))
    }
    if (x$restrict) {
      cat("\nSafety constraints implemented:\n")
      ###Begin Phil's modification
      cat("\t (1) No skipping doses in escalation;\n")
      cat("\t (2) No escalation before followup of",x$followup_b4_esc, "at current dose.\n")
      cat("\t (3) No assignment to dose with estimated DLT rate beyond ", x$no.exceed + x$target, ".\n",sep="")
      cat("\t (4) Stopping trial altogether if at any point after patient ", x$earliest_stop," the estimated DLT rate at all dose levels exceeds ", x$no.exceed + x$target, ".\n",sep="")
    }
    if(x$first.cohort.only) {
      cat("\nThe first", x$cohort.size, "patients were enrolled at the starting dose level, with patients assigned individually thereafter")
    } else {
      cat("\nPatients were enrolled in cohorts of", x$cohort.size)
    }
    cat("\nThe proportion of trials for which at some point during the trial the lowest dose had an estimated rate of toxicity exceeding ", x$no.exceed + x$target, ", which is the pre-specified safety bound, was ", mean(x$stop.for.tox>0),".\n",sep="");
    ###End Phil's modification
    cat("\nThe working model is", x$model, "\n")
    if (x$model == "empiric") {
      cat("\tptox = dose^{exp(beta)} with doses =", round(x$dosescaled,
                                                          digits = dgt), "\n")
    }
    else {
      cat("\tlogit(ptox) = a + exp(beta)*dose, with a =",
          x$intcpt, "\n\tand doses =", signif(x$dosescaled,
                                              digits = dgt), "\n")
    }
    x0 <- x$x0
    if (x$method == "bayes") {
      cat("\tand beta is estimated by its posterior mean \n\tassuming a normal prior with mean 0 and variance",
          x$prior.var, "\n")
    }
    else if (x$method == "mle") {
      cat("\tand beta is estimated by its mle\n")
    }
    if (x$tite) {
      cat("\nThe", x$scheme, "function is used to assign weights to patients, using parameters\n",unlist(x$scheme_args),".\n\n")
      cat("Patient arrival is modeled as a", x$accrual,
          "process\n")
      cat("\twith rate", x$rate, "patients per", x$obswin,
          "time units (= observation window).\n\n")
      if (length(x$x0) > 1) {
        cat("\tA minimum waiting time of", x$tgrp, "time units is imposed\n")
        cat("\tbetween two dose cohorts in the initial stage.\n")
      }
    }
  }
}