#' Run dose-finding simulations
#' @description Run dose-finding simulations based on a customized decision
#'   table.
#' @details Assume there are \eqn{d} dose levels to be studied. Let
#'   \eqn{n_i} and \eqn{m_i} denote the cumulative number of patients treated
#'   and the cumulative number of DLTs observed at the current dose level,
#'   respectively. Let \eqn{n_{max}} be the maximum number of patients allowed
#'   at each dose level. The procedure is as follows:
#' \describe{
#' \item{Step 1}{Update the cumulative numbers of DLTs (\eqn{m_i}) and
#' total treated patients (\eqn{n_i}) at the current dose, then use the
#' decision table to choose an action. If the decision is \code{"S"}, go to
#' Step 2. If the decision is \code{"D"} or \code{"DU"}, go to Step 3. If the
#' decision is \code{"E"}, go to Step 4.}
#' \item{Step 2}{If \eqn{n_i = n_{max}}, declare dose \eqn{i} as the MTD.
#' Otherwise, treat an additional cohort at the current dose and return to
#' Step 1.}
#' \item{Step 3}{If the current dose is the lowest dose, stop the trial and
#' declare that the MTD is below the lowest dose. Otherwise, if the next lower
#' dose has not yet reached \eqn{n_{max}}, treat an additional cohort there,
#' move to that dose, and return to Step 1. If the next lower dose has already
#' reached \eqn{n_{max}}, stop the trial and declare that dose as the MTD. If
#' the decision is \code{"DU"}, record the current dose as unusable and do not
#' treat additional patients there.}
#' \item{Step 4}{If the current dose is the highest dose, stop the trial and
#' declare that the MTD is above the highest dose. Otherwise, if the next
#' higher dose has been marked \code{"DU"}, continue treating the current dose
#' until it reaches \eqn{n_{max}}; if that limit is reached, declare the
#' current dose as the MTD. If the next higher dose is available and has not
#' yet reached \eqn{n_{max}}, treat an additional cohort there, move up to
#' that dose, and return to Step 1. Otherwise, declare the current dose as the
#' MTD.}
#' }
#' @param truep A vector of length \eqn{k}, giving the true toxicity
#'   probabilities for the dose levels under study.
#' @param decTable A customized decision table in the same format as the output
#'   of \code{\link{dec.table}}.
#' @param start.level Starting dose level. Defaults to 1, the lowest dose
#'   level.
#' @param nsim Number of simulated trials. Defaults to 1000.
#' @return An object of class \code{"dec.sim"}. Use
#'   \code{\link{summary.dec.sim}} to obtain and print a summary table of the
#'   results. The returned object is a list containing:
#'   \item{mtd}{A vector of dose levels giving the recommended maximum
#'   tolerated dose (MTD) at the end of the trial.}
#'   \item{mtd.prob}{A vector of length \eqn{k} giving the proportion of trials
#'   that selected each dose level as the MTD.}
#'   \item{over.prob}{A vector of length \eqn{k} giving the proportion of
#'   trials that selected each dose level as above the MTD.}
#'   \item{n.patients}{The average number of patients treated at each dose
#'   level.}
#'   \item{dlt}{The average number of DLTs observed at each dose level.}
#'   \item{truep}{The input true toxicity probabilities.}
#'   \item{start.level}{The input starting dose level.}
#'   \item{nsim}{The input number of simulated trials.}
#' @author Wenchuan Guo <wguo1017@gmail.com>
#' @import stats
#' @export
#' @examples
#' truep <- c(0.3, 0.45, 0.5, 0.6)
#' res <- dec.table(0.6,0.4,0.2,0.3,c(3,3,3))
#' out <- dec.sim(truep, as.matrix(res$table), start.level = 2, nsim = 1000)
#' summary(out, pt = 0.3)

dec.sim  <- function(truep, decTable, start.level = 1, nsim = 1000) {
  # initialization
  n_dose <- length(truep)
  input.sample <- as.numeric(colnames(decTable))
  maxn <- nrow(decTable) - 1
  nc <- ncol(decTable)
  if(input.sample[length(input.sample)] != maxn) {
    stop("Please check decision table format")
  }
  add <- c(input.sample[1], diff(input.sample))
  decisions <- as.matrix(decTable)
  storage.mode(decisions) <- "character"
  mtd <- rep("", nsim)
  np <- matrix(0, nsim, n_dose)
  dlt <- matrix(0, nsim, n_dose)
  des <- matrix("", nsim, n_dose)
  for(i in seq_len(nsim)){
    # Doses marked as unavailable for future treatment.
    rm.dose <- rep(FALSE, n_dose)
    # Current dose level.
    dose <- start.level
    # Current stage for each dose level.
    sample.stage <- rep(1, n_dose)
    while(mtd[i] == ""){
      if(sample.stage[dose] > nc) {
        stop("Please check decision table format")
      }
      add.sample <- add[sample.stage[dose]]
      np[i, dose] <- np[i, dose] + add.sample
      dlt[i, dose] <- dlt[i, dose] + sum(rbinom(add.sample, 1, truep[dose]))
      des[i, dose] <- decisions[dlt[i, dose] + 1, sample.stage[dose]]
      sample.stage[dose] <- sample.stage[dose] + 1
      # Stay at the current dose.
      if(des[i, dose] == "S"){
        if(np[i, dose] != maxn) {
          dose <- dose
        } 
        else {
          mtd[i] <- as.character(dose)
        } 
      }
      # Escalate to the next dose.
      if(des[i, dose] == "E") {
        if(dose != n_dose) {
          # Check whether the next dose is still available.
          if(rm.dose[dose + 1]) {
            if(np[i, dose] != maxn) {
              dose <- dose
            } else {
              mtd[i] <- as.character(dose)
            }
          } else {
            if(np[i, dose + 1] != maxn) {
              dose <- dose + 1
            } else {
              mtd[i] <- as.character(dose)
            }
          }
        } else {
          mtd[i] <- "U"
        }
      }  
      # De-escalate to the previous dose.
      if(des[i, dose] == "D") {
        if(dose != 1) {
          if(np[i, dose-1] != maxn) {
            dose <- dose - 1
          } else {
            mtd[i] <- as.character(dose - 1L)
          }
        } else {
          mtd[i] <- "L"
        }
      }
      # De-escalate and mark the current dose as unavailable.
      if(des[i, dose] == "DU") {
        if(dose != 1) {
          # Do not return to this dose again.
          rm.dose[dose] <- TRUE
          if(np[i, dose-1] != maxn) {
            dose <- dose - 1
          } else {
            mtd[i] <- as.character(dose - 1L)
          }
        } else {
          mtd[i] <- "L"
        }
      }
    }		
  }
  # Calculate the MTD selection probability.
  mtd.prob <- vapply(c(as.character(seq_len(n_dose)), "L", "U"), function(ii) mean(mtd == ii), numeric(1))
  # Calculate the probability of selecting doses above the MTD.
  over <- matrix(0, nsim, n_dose)
  over[des == "D" | des == "DU"] <- 1
  over[des == "S" | des == "E"] <- 0.5
  max.over <- apply(over, 1, max)
  for(i in seq_len(nsim)) {
    if(max.over[i] == 1) {
      iid <- which(over[i, ] == 1)[1]
    } else {
      iid <- min(max(which(over[i, ] == 0.5)) + 1, n_dose)
    }
    over[i, iid : n_dose] <- 1
  }
  over[over == 0.5] <- 0
  over.prob <- colMeans(over)
  out <- list(mtd = mtd, mtd.prob = mtd.prob, dlt = colMeans(dlt), n.patients = colMeans(np), over.prob = over.prob, truep = truep, start.level = start.level, nsim = nsim)
  class(out) <- "dec.sim"
  return(out)
}
