#' Two-stage designs
#'
#' \code{TwoStageDesign} is the fundamental design class of the
#' \pkg{\link{adoptr}} package.
#' Formally, we represent a generic two-stage design as a five-tuple
#' \ifelse{html}{\out{(n<sub>1</sub>, c<sub>1</sub><sup>f</sup>, c<sub>1</sub><sup>e</sup>, n<sub>2</sub>(&middot;), c<sub>2</sub>(&middot;))}}{\eqn{\big(n_1, c_1^f, c_1^e, n_2(\cdot), c_2(\cdot)\big)}}.
#' Here, \ifelse{html}{\out{n<sub>1</sub>}}{\eqn{n_1}} is the first-stage sample
#' size (per group), \ifelse{html}{\out{c<sub>1</sub><sup>f</sup>}}{\eqn{c_1^f}}
#' and \ifelse{html}{\out{c<sub>1</sub><sup>e</sup>}}{\eqn{c_1^e}} are
#' boundaries for early stopping for futility and efficacy, respectively.
#' Since the trial design is a two-stage design, the elements
#' \ifelse{html}{\out{n<sub>2</sub>(&middot;)}}{\eqn{n_2(\cdot)}} (stage-two sample
#' size) and \ifelse{html}{\out{c<sub>2</sub>(&middot;)}}{\eqn{c_2(\cdot)}}
#' (stage-two critical value) are functions of the first-stage outcome
#' \ifelse{html}{\out{X<sub>1</sub>=x<sub>1</sub>}}{\eqn{X_1=x_1}}.
#' \ifelse{html}{\out{X<sub>1</sub>}}{\eqn{X_1}} denotes the first-stage test
#' statistic. A brief description on this definition of two-stage designs can be
#' read \href{https://optad.github.io/adoptr/articles/adoptr.html}{here}.
#' For available methods, see the 'See Also' section at the end of this page.
#'
#' @slot n1 cf. parameter 'n1'
#' @slot c1f cf. parameter 'c1f'
#' @slot c1e cf. parameter 'c1e'
#' @slot n2_pivots vector of length 'order' giving the values of n2 at the
#'     pivot points of the numeric integration rule
#' @slot c2_pivots vector of length order giving the values of c2 at the
#'     pivot points of the numeric integration rule
#' @slot x1_norm_pivots normalized pivots for integration rule (in \[-1, 1\])
#'     the actual pivots are scaled to the interval \[c1f, c1e\] and can be
#'     obtained by the internal method \cr
#'     \code{adoptr:::scaled_integration_pivots(design)}
#' @slot weights weights of of integration rule at \code{x1_norm_pivots} for
#'     approximating integrals over \code{x1}
#' @slot tunable named logical vector indicating whether corresponding slot is
#'     considered a tunable parameter (i.e. whether it can be changed during
#'     optimization via \code{\link{minimize}} or not; cf. \cr
#'     \code{\link{make_fixed}})
#'
#' @seealso For accessing sample sizes and critical values safely, see methods in
#' \code{\link{n}} and \code{\link{c2}}; for modifying behaviour during optimizaton
#' see \code{\link{make_tunable}}; to convert between S4 class represenation and
#' numeric vector, see \code{\link{tunable_parameters}}; for simulating from a given
#' design, see \code{\link[=simulate,TwoStageDesign,numeric-method]{simulate}};
#' for plotting see \code{\link{plot,TwoStageDesign-method}}.
#' Both \link[=GroupSequentialDesign-class]{group-sequential} and
#' \link[=OneStageDesign]{one-stage designs} (!) are implemented as subclasses of
#' \code{TwoStageDesign}.
#'
#' @exportClass TwoStageDesign
setClass("TwoStageDesign", representation(
        n1        = "numeric",
        c1f       = "numeric",
        c1e       = "numeric",
        n2_pivots = "numeric",
        c2_pivots = "numeric",
        x1_norm_pivots = "numeric",
        weights   = "numeric",
        tunable   = "logical"
    ))

#' Two-stage design for time-to-event-endpoints
#'
#' When conducting a study with time-to-event endpoints, the main interest is not the
#' sample size, but the number of overall necessary events. Thus, \pkg{\link{adoptr}} does not use
#' the sample size for calculating the design. Instead,
#' it uses the number of events directly.
#' In the framework of \pkg{\link{adoptr}}, all the calculations are done group-wise, where both of the groups are equal-sized.
#' This means, that the number of events \pkg{\link{adoptr}} has computed is only half of the overall number of necessary events.
#' In order to facilitate this issue, the look of the
#' \code{summary} and \code{show} functions have been changed in the survival analysis setting.
#' The sample size is implicitly determined
#' by dividing the number of events by the event rate. Survival objects are only
#' created, when the argument \code{event_rate} is not missing.
#'
#' @slot event_rate probability that a subject in either group will eventually have an event
#'
#' @seealso \code{\link{TwoStageDesign}} for superclass and inherited methods
#' @exportClass TwoStageDesignSurvival
setClass("TwoStageDesignSurvival", representation(
  event_rate = "numeric"),
  contains = "TwoStageDesign")



#' @param n1 stage-one sample size
#'
#' @rdname TwoStageDesign-class
#' @export
setGeneric("TwoStageDesign", function(n1, ...) standardGeneric("TwoStageDesign"))

#' @template c1f
#' @template c1e
#' @param n2_pivots numeric vector, stage-two sample size on the integration
#' pivot points
#' @param c2_pivots numeric vector, stage-two critical values on the integration
#' pivot points
#' @param event_rate probability that a subject in either group will eventually have an event,
#' only needs to be specified for time-to-event endpoints
#' @template order
#' @template dotdotdot
#'
#' @rdname TwoStageDesign-class
#' @export
setMethod("TwoStageDesign", signature = "numeric",
    function(n1, c1f, c1e, n2_pivots, c2_pivots, order = NULL, event_rate, ...) {

        if (length(n2_pivots) != length(c2_pivots))
            stop("n2_pivots and c2_pivots must be of same length!")
        if (is.null(order)) {
            order <- length(n2_pivots)
        } else if (length(n2_pivots) != order) {
            n2_pivots <- rep(n2_pivots[1], order)
            c2_pivots <- rep(c2_pivots[1], order)
        }

        rule           <- GaussLegendreRule(as.integer(order))
        tunable        <- logical(8) # initialize to all false
        tunable[1:5]   <- TRUE
        names(tunable) <- c("n1", "c1f", "c1e", "n2_pivots", "c2_pivots", "x1_norm_pivots", "weights", "tunable")

        if (missing(event_rate)) {
          new("TwoStageDesign", n1 = n1, c1f = c1f, c1e = c1e, n2_pivots = n2_pivots,
              c2_pivots = c2_pivots, x1_norm_pivots = rule$nodes, weights = rule$weights,
              tunable = tunable)
        } else {
          new("TwoStageDesignSurvival",n1 = n1, c1f = c1f, c1e = c1e, n2_pivots = n2_pivots,
              c2_pivots = c2_pivots, x1_norm_pivots = rule$nodes, weights = rule$weights,
              tunable = tunable,event_rate=event_rate)
        }

    })

#' SurvivalDesign
#'
#' \code{SurvivalDesign} is a function that converts an arbitrary design to a survival design.
#' @param design design that should be converted to a survival design
#' @param event_rate probability that a subject in either group will eventually have an event
#' @examples
#' design <- get_initial_design(0.4, 0.025, 0.1)
#' SurvivalDesign(design, 0.8)
#'
#' design_os <- get_initial_design(0.4, 0.025, 0.1, type_design = "one-stage")
#' design_gs <- get_initial_design(0.4, 0.025, 0.1, type_design = "group-sequential")
#' 
#' @return Converts any type of design to a survival design
#'
#' @export
setGeneric("SurvivalDesign", function(design, event_rate) standardGeneric("SurvivalDesign"))


#' @rdname SurvivalDesign
#' @export
setMethod("SurvivalDesign", signature("TwoStageDesign"),
          function(design,event_rate){
            tunable <- logical(8) # initialize to all false
            tunable[1:5] <- TRUE
            names(tunable) <- c("n1", "c1f", "c1e", "n2_pivots", "c2_pivots", "x1_norm_pivots", "weights", "tunable")
            new("TwoStageDesignSurvival",
                n1 = design@n1, c1f = design@c1f, c1e = design@c1e, n2_pivots = design@n2_pivots,
                c2_pivots = design@c2_pivots,
                x1_norm_pivots = design@x1_norm_pivots, weights = design@weights,
                tunable = tunable, event_rate = event_rate)
          })

#' @param event_rate probability that a subject in either group will eventually have an event
#' @param n1 design object to convert (overloaded from \code{TwoStageDesign})
#'
#' @rdname SurvivalDesign
#'
#' @export
setMethod("TwoStageDesign", signature("TwoStageDesign"),
          function(n1, event_rate){
            if(!missing(event_rate)) SurvivalDesign(n1, event_rate)
            else n1
          })


#' Switch between numeric and S4 class representation of a design
#'
#' Get tunable parameters of a design as numeric vector via
#' \code{tunable_parameters} or \code{update} a design object with a suitable
#' vector of values for its tunable parameters.
#'
#' @param    object    \code{TwoStageDesign} object to update
#' @template dotdotdot
#'
#' @details
#' The \code{tunable} slot of a \code{\link{TwoStageDesign}} stores information about
#' the set of design parameters which are considered fixed (not changed during
#' optimization) or tunable (changed during optimization).
#' For details on how to fix certain parameters or how to make them tunable
#' again, see \code{\link{make_fixed}} and \code{\link{make_tunable}}.
#'
#' @return \code{tunable_parameters} returns the numerical values of all
#' tunable parameters as a vector.
#' \code{update} returns the updated design.
#'
#' @examples
#' design  <- TwoStageDesign(25, 0, 2, 25, 2, order = 5)
#' tunable_parameters(design)
#' design2 <- update(design, tunable_parameters(design) + 1)
#' tunable_parameters(design2)
#'
#' @seealso \code{\link{TwoStageDesign}}
#'
#' @export
setGeneric("tunable_parameters", function(object, ...) standardGeneric("tunable_parameters"))

#' @rdname tunable_parameters
#' @export
setMethod("tunable_parameters", signature("TwoStageDesign"),
          function(object, ...) {
              res <- numeric(0)
              for (i in 1:length(object@tunable)) {
                  if (object@tunable[i])
                      res <- c(res, slot(object, names(object@tunable)[i]))
              }
              return(res)
          })

#' @param params vector of design parameters, must be in same order as returned
#'   by \cr
#'   \code{tunable_parameters}
#'
#' @rdname tunable_parameters
#' @export
setMethod("update", signature("TwoStageDesign"),
          function(object, params, ...) {
              tunable_names <- names(object@tunable)[object@tunable]
              res <- object
              idx <- 1
              for (i in 1:length(tunable_names)) {
                  slotname <- tunable_names[i]
                  k <- length(slot(object, name = slotname))
                  slot(res, name = slotname) <- params[idx:(idx + k - 1)]
                  idx <- idx + k
              }
              return(res)
          })



#' Fix parameters during optimization
#'
#' The methods \code{make_fixed} and \code{make_tunable} can be used to modify
#' the 'tunability' status of parameters in a \code{\link{TwoStageDesign}}
#' object.
#' Tunable parameters are optimized over, non-tunable ('fixed') parameters are
#' considered given and not altered during optimization.
#'
#' @param x \code{TwoStageDesign} object
#' @param ... unquoted names of slots for which the tunability status should be
#' changed.
#'
#' @return an updated object of class \code{\link{TwoStageDesign}}
#'
#' @examples
#' design <- TwoStageDesign(25, 0, 2, 25, 2, order = 5)
#' # default: all parameters are tunable (except integration pivots,
#' # weights and tunability status itself)
#' design@tunable
#'
#' # make n1 and the pivots of n2 fixed (not changed during optimization)
#' design <- make_fixed(design, n1, n2_pivots)
#' design@tunable
#'
#' # make them tunable again
#' design <- make_tunable(design, n1, n2_pivots)
#' design@tunable
#'
#' @seealso \code{\link{TwoStageDesign}}, \code{\link{tunable_parameters}} for
#' converting tunable parameters of a design object to a numeric vector (and back),
#' and \code{\link{minimize}} for the actual minimzation procedure
#'
#' @export
setGeneric("make_tunable", function(x, ...) standardGeneric("make_tunable"))

#' @rdname make_tunable
#' @export
setMethod("make_tunable", signature("TwoStageDesign"),
          function(x, ...) {
              params <- sapply(substitute(list(...))[-1], deparse)
              res    <- x
              for (i in 1:length(x@tunable)) {
                  if (names(x@tunable)[i] %in% params)
                      res@tunable[i] <- TRUE
              }
              return(res)
          })



#' @rdname make_tunable
#' @export
setGeneric("make_fixed", function(x, ...) standardGeneric("make_fixed"))

#' @rdname make_tunable
#' @export
setMethod("make_fixed", signature("TwoStageDesign"),
          function(x, ...) {
              params <- sapply(substitute(list(...))[-1], deparse)
              res    <- x
              for (i in 1:length(x@tunable)) {
                  if (names(x@tunable)[i] %in% params)
                      res@tunable[i] <- FALSE
              }
              return(res)
          })






#' @rdname n
#' @export
setGeneric("n1", function(d, ...) standardGeneric("n1"))

#' @rdname n
#' @export
setMethod("n1", signature("TwoStageDesign"),
          function(d, round = TRUE, ...) {
              n1 <- d@n1
              if (round)
                  n1 <- round(n1)
              return(n1)
          })



#' @rdname n
#' @export
setGeneric("n2", function(d, x1, ...) standardGeneric("n2"))

#' @rdname n
#' @export
setMethod("n2", signature("TwoStageDesign", "numeric"),
          function(d, x1, round = TRUE, ...) {
              res <- ifelse(x1 < d@c1f | x1 > d@c1e, 0, 1) *
                  pmax(
                      0,
                      stats::splinefun(
                          scaled_integration_pivots(d),
                          d@n2_pivots,
                          method = "monoH.FC"
                        )(x1)
                  )
              if (round)
                  res <- round(res)
              return(res)
          })



#' Query sample size of a design
#'
#' Methods to access the stage-one, stage-two, or overall sample size of a
#' \code{\link{TwoStageDesign}}.
#' \code{n1} returns the first-stage sample size of a design,
#' \code{n2} the stage-two sample size conditional on the stage-one test
#' statistic and \code{n} the overall sample size \code{n1 + n2}.
#' Internally, objects of the class \code{TwoStageDesign} allow non-natural,
#' real sample sizes to allow smooth optimization (cf. \code{\link{minimize}} for
#' details).
#' The optional argument \code{round} allows to switch between the internal
#' real representation and a rounded version (rounding to the next positive
#' integer).
#'
#' @examples
#' design <- TwoStageDesign(
#'    n1    = 25,
#'    c1f   = 0,
#'    c1e   = 2.5,
#'    n2    = 50,
#'    c2    = 1.96,
#'    order = 7L
#' )
#'
#' n1(design) # 25
#' design@n1 # 25
#'
#' n(design, x1 = 2.2) # 75
#'
#'
#' @template d
#' @template x1
#' @template round
#' @template dotdotdot
#'
#' @return sample size value of design \code{d} at point \code{x1}
#'
#' @seealso \code{\link{TwoStageDesign}}, see \code{\link{c2}} for accessing
#' the critical values
#'
#' @rdname n
#' @export
setGeneric("n", function(d, x1, ...) standardGeneric("n"))

#' @rdname n
#' @export
setMethod("n", signature("TwoStageDesign", "numeric"),
          function(d, x1, round = TRUE, ...) n2(d, x1, round, ...) + n1(d, round, ...))





#' Query critical values of a design
#'
#' Methods to access the stage-two critical values of a
#' \code{\link{TwoStageDesign}}.
#' \code{c2} returns the stage-two critical value conditional on the stage-one test
#' statistic.
#'
#' @examples
#' design <- TwoStageDesign(
#'   n1    = 25,
#'   c1f   = 0,
#'   c1e   = 2.5,
#'   n2    = 50,
#'   c2    = 1.96,
#'   order = 7L
#' )
#'
#' c2(design, 2.2) # 1.96
#' c2(design, 3.0) # -Inf
#' c2(design, -1.0) # Inf
#'
#' @template d
#' @template x1
#' @template dotdotdot
#'
#' @seealso \code{\link{TwoStageDesign}}, see \code{\link{n}} for accessing
#' the sample size of a design
#'
#' @return the critical value function \code{c2} of design \code{d} at position \code{x1}
#'
#' @examples
#' design <- TwoStageDesign(
#'    n1    = 25,
#'    c1f   = 0,
#'    c1e   = 2.5,
#'    n2    = 50,
#'    c2    = 1.96,
#'    order = 7L
#' )
#'
#' c2(design, 2.2) # 1.96
#' c2(design, 3.0) # -Inf
#' c2(design, -1.0) # Inf
#'
#' @rdname critical-values
#' @export
setGeneric("c2", function(d, x1, ...) standardGeneric("c2"))

#' @rdname critical-values
#' @export
setMethod("c2", signature("TwoStageDesign", "numeric"),
          function(d, x1, ...) ifelse(x1 < d@c1f, Inf,
                                      ifelse(x1 > d@c1e, -Inf,
                                             stats::splinefun(
                                                 scaled_integration_pivots(d),
                                                 d@c2_pivots,
                                                 method = "monoH.FC"
                                                 )(x1)
                                             )
          )
)





# internal, get integration pivots scales to [c1f, c1e]
setGeneric("scaled_integration_pivots", function(d, ...) standardGeneric("scaled_integration_pivots"))

setMethod("scaled_integration_pivots", signature("TwoStageDesign"),
          function(d, ...){
              h <- (d@c1e - d@c1f) / 2
              return(h * d@x1_norm_pivots + (h + d@c1f))
          })


design2str <- function(design, optimized = FALSE, no_pivots = 100) {
  
  if (is(design, 'TwoStageDesignSurvival')) {
    n2_piv <- seq(design@c1f, design@c1e, length.out = no_pivots)
    n2range <- range(n2(design, n2_piv))
    if (is(design, 'OneStageDesign')) {
      return(sprintf("OneStageDesignSurvival<%sn_events=%i;c=%.2f>", 
                                                     if (optimized) "optimized;" else "", n1(design), design@c1f))
    } else {
      return(sprintf(
        "%s<%sn_events1=%i;%.1f<=x1<=%.1f;n_events2=%s>",
        class(design)[1], if (optimized) "optimized;" else "", n1(design),
        design@c1f, design@c1e,
        if (diff(n2range) == 0) sprintf("%i", n2range[1]) else paste(n2range, collapse = '-')
      ))}
  }
  if (is(design, 'OneStageDesign')) {
    return(sprintf("OneStageDesign<%sn=%i;c=%.2f>", 
                   if (optimized) "optimized;" else "", n1(design), design@c1f))
    }
    n2_piv <- seq(design@c1f, design@c1e, length.out = no_pivots)
    n2range <- range(n2(design, n2_piv))
    sprintf(
        "%s<%sn1=%i;%.1f<=x1<=%.1f:n2=%s>",
        class(design)[1], if (optimized) "optimized;" else "", n1(design),
        design@c1f, design@c1e,
        if (diff(n2range) == 0) sprintf("%i", n2range[1]) else paste(n2range, collapse = '-')
    )
}
setMethod("print", signature('TwoStageDesign'), function(x, ...) design2str(x))

setMethod("show", signature(object = "TwoStageDesign"), function(object) {
    cat(print(object), "\n")
})




#' Plot \code{TwoStageDesign} with optional set of conditional scores
#'
#' This method allows to plot the stage-two sample size and decision boundary
#' functions of a chosen design.
#'
#' \code{\link{TwoStageDesign}} and
#' user-defined elements of the class \code{\link[=Scores]{ConditionalScore}}.
#'
#' @template plot
#' @param rounded should n-values be rounded?
#' @param k number of points to use for plotting
#' @param ... further named \code{ConditinonalScores} to plot for the design
#' and/or further graphic parameters
#'
#' @seealso \code{\link{TwoStageDesign}}
#'
#' @return a plot of the two-stage design
#'
#' @examples
#' design <- TwoStageDesign(50, 0, 2, 50, 2, 5)
#' cp     <- ConditionalPower(dist = Normal(), prior = PointMassPrior(.4, 1))
#' plot(design, "Conditional Power" = cp, cex.axis = 2)
#'
#' @export
setMethod("plot", signature(x = "TwoStageDesign"),
          function(x, y = NULL, ..., rounded = TRUE, k = 100) {
              args   <- list(...)
              if(length(args) > 0) {
                  scores <- args[which(sapply(args, function(s) is (s, "Score")))]
                  if (!all(sapply(scores, function(s) is(s, "ConditionalScore"))))
                     stop("additional scores must be ConditionalScores")
                  plot_opts <- args[which(sapply(args, function(s) !is(s, "Score")))]
              } else {
                  scores    <- NULL
                  plot_opts <- NULL
              }
              oldpar <- graphics::par(no.readonly = TRUE)
              on.exit(graphics::par(oldpar))
              opts <- graphics::par(c(list(mfrow = c(1, length(scores) + 2)), plot_opts))
              x1   <- seq(x@c1f, x@c1e, length.out = k)
              x2   <- seq(x@c1f - (x@c1e - x@c1f)/5, x@c1f - .01*(x@c1e - x@c1f)/5, length.out = k)
              x3   <- seq(x@c1e + .01*(x@c1e - x@c1f)/5, x@c1e + (x@c1e - x@c1f)/5, length.out = k)
              x4   <- seq(x@c1f - (x@c1e - x@c1f)/5, x@c1e + (x@c1e - x@c1f)/5, length.out = k)
              if (is(x, "TwoStageDesignSurvival")) caption <- "Half of number of events" # nocov
              else caption <- "Group-wise sample size" # nocov
              graphics::plot(x1, sapply(x1, function(z) n(x, z, round = rounded)), type = 'l',
                             xlim = c(min(x4), max(x4)),
                             ylim = c(0, 1.05 * max(sapply(x1, function(z) n(x, z, round = rounded)))),
                             main = caption, ylab = "" , xlab = expression("x"[1]))
              graphics::lines(x2, sapply(x2, function(z) n(x, z, round = rounded)))
              graphics::lines(x3, sapply(x3, function(z) n(x, z, round = rounded)))
              graphics::plot(x4, c2(x, x4), type = 'l', main = "Stage-two critical value",
                             ylab = "", xlab = expression("x"[1]))
              if (length(scores) > 0) {
                  for (i in 1:length(scores)) {
                      y <- list(
                          left =   evaluate(scores[[i]], x, x2),
                          middle = evaluate(scores[[i]], x, x1),
                          right =  evaluate(scores[[i]], x, x3)
                      )
                      expand <- .05*(max(do.call(c, y)) - min(do.call(c, y)))
                      graphics::plot(
                          x1, y$middle,
                          type = 'l',
                          xlim = c(min(x4), max(x4)),
                          ylim = c(min(do.call(c, y)) - expand, max(do.call(c, y)) + expand),
                          main = names(scores[i]),
                          ylab = "",
                          xlab = expression("x"[1])
                      )
                      graphics::lines(x2, y$left)
                      graphics::lines(x3, y$right)
                  }
              }
              graphics::par(opts)
          })



#' @details
#' \code{summary} can be used to quickly compute and display basic facts about
#' a TwoStageDesign.
#' An arbitrary number of names \code{\link[=Scores]{UnconditionalScore}} objects can be
#' provided via the optional arguments \code{...} and are included in the summary displayed using
#' \code{\link{print}}.
#'
#' @template object
#' @param rounded should rounded n-values be used?
#'
#' @examples
#' design <- TwoStageDesign(50, 0, 2, 50.0, 2.0, 5)
#' pow    <- Power(Normal(), PointMassPrior(.4, 1))
#' summary(design, "Power" = pow)
#'
#' @rdname TwoStageDesign-class
#' @export
setMethod("summary", signature("TwoStageDesign"),
          function(object, ..., rounded = TRUE) {
              scores <- list(...)
              if (!all(sapply(scores, function(s) is(s, "Score"))))
                  stop("optional arguments must be Scores")
              if (length(scores) > 0) {
                  cond_scores   <- scores[which(sapply(scores, function(x) is(x, "ConditionalScore")))]
                  uncond_scores <- scores[which(sapply(scores, function(x) is(x, "UnconditionalScore")))]
              } else {
                  cond_scores   <- scores
                  uncond_scores <- scores
              }
              res <- list(
                  design        = object,
                  uncond_scores = sapply(uncond_scores, function(s) evaluate(s, object, optimization = !rounded, ...)),
                  cond_scores   = cond_scores,
                  n1            = object@n1,
                  c1f           = object@c1f,
                  c1e           = object@c1e,
                  n2_pivots     = object@n2_pivots,
                  c2_pivots     = object@c2_pivots
              )
              if(is(object, "TwoStageDesignSurvival")) {
                res <- c(res, event_rate = object@event_rate)
              }
              names(res$uncond_scores) <- names(uncond_scores)
              names(res$cond_scores)   <- names(cond_scores)
              class(res)               <- c("TwoStageDesignSummary", "list")
              return(res)
          })



#' @rawNamespace S3method(print, TwoStageDesignSummary)
print.TwoStageDesignSummary <- function(x, ..., rounded = TRUE) {
    space <- 3
    
    if (is(x$design, "TwoStageDesignSurvival")) {
      cat("For two-armed trials: nevs denotes half of the overall number of required events. nrec denotes the resulting group-wise sample size.\n\n")
      cat(glue::glue(
        '{class(x$design)}: ',
        'nevs1={sprintf("%3i", n1(x$design))} --> ',
        'nrec1={sprintf("%3i", round(n1(x$design)/x$design@event_rate))}',
        '\n\r'))
    } else {
      cat(glue::glue(
          '{class(x$design)}: ',
          'n1 = {sprintf("%3i", n1(x$design))} ',
          '\n\r'
      ))
    }
    x1 <- c(x$c1f - sqrt(.Machine$double.eps), scaled_integration_pivots(x$design), x$c1e + sqrt(.Machine$double.eps))
    n2_nr <- sapply(x1,function(y) n2(x$design, y, round=FALSE))
    n2 <- sapply(x1, function(y) n2(x$design, y))
    c2 <- sapply(x1, function(y) c2(x$design, y))

    # compute maximal length of rownames
    maxlength <- max(nchar('futility'),
                     ifelse(length(x$uncond_scores) > 0, max(sapply(names(x$uncond_scores), nchar)), 0),
                     ifelse(length(x$cond_scores) > 0, max(sapply(names(x$cond_scores), nchar)) + 4, 0))

    # add columnnames such that 'continue' is centered
    len  <- maxlength - nchar('futility')
    len2 <- max(nchar(paste0(sprintf("%+5.2f", c2[- c(1, length(c2))]), collapse = " ")) -
        nchar("continue"), 0)
    cat(glue::glue(' ',
                   '{strrep(" ", len + 7 + space)}',
                   'futility |',
                   '{strrep(" ", ceiling(len2/2))}',
                   ' continue ',
                   '{strrep(" ", floor(len2/2))}',
                   '| efficacy',
                   '\n\r'))

    # start with design characteristics
    len <- maxlength - nchar('x1')
    cat(glue::glue(' ','{strrep(" ", len)}','x1:', '{strrep(" ", space)}',
                   ' {sprintf("%5.2f", x1[1])} | ',
                   '{paste0(
                           sprintf("%5.2f", x1[- c(1, length(x1))]),
                           collapse = " ")}',
                   ' | {sprintf("%5.2f", x1[length(x1)])}',
                   '\n\r'))

    len <- maxlength - nchar('c2(x1)')
    cat(glue::glue(' ', '{strrep(" ", len)}','c2(x1):', '{strrep(" ", space)}',
                   ' {sprintf("%+5.2f", c2[1])} | ',
                   '{paste0(
                           sprintf("%+5.2f", c2[- c(1, length(c2))]),
                           collapse = " ")}',
                   ' | {sprintf("%+5.2f", c2[length(c2)])}',
                   '\n\r'))

    len <- maxlength - nchar('n2(x1)')
    
    if (is(x$design, "TwoStageDesignSurvival")) {
      cat(glue::glue(' ','{strrep(" ", len)}','nevs2(x1):',
                     ' {sprintf("%5i", n2[1])} | ',
                     '{paste0(
                               sprintf("%5i", n2[- c(1, length(n2))]),
                               collapse = " ")}',
                     ' | {sprintf("%5i", n2[length(n2)])}',
                     '\n\r'))
      
      cat(glue::glue(' ','{strrep(" ", len)}','nrec2(x1):',
                     ' {sprintf("%5i", round(n2_nr[1]/x$design@event_rate))} | ',
                     '{paste0(
                               sprintf("%5i", round(n2_nr[- c(1, length(n2))]/x$design@event_rate)),
                               collapse = " ")}',
                     ' | {sprintf("%5i", round(n2_nr[length(n2)]/x$design@event_rate))}',
                     '\n\r'))
    } else {
      cat(glue::glue(' ','{strrep(" ", len)}','n2(x1):', '{strrep(" ", space)}',
                     ' {sprintf("%5i", n2[1])} | ',
                     '{paste0(
                             sprintf("%5i", n2[- c(1, length(n2))]),
                             collapse = " ")}',
                     ' | {sprintf("%5i", n2[length(n2)])}',
                     '\n\r'))
    }

    if (length(x$cond_scores) > 0) {
        for (i in 1:length(x$cond_scores)) {
            len <- maxlength - nchar(names(x$cond_scores)[i]) - nchar('(x1)')
            cat(glue::glue('{strrep(" ", len)}','{names(x$cond_scores)[i]}(x1):', '{strrep(" ", space)}',
                           ' {sprintf("%5.2f", evaluate(x$cond_scores[[i]], x$design, x1[1]))} | ',
                           '{paste0(
                           sprintf("%5.2f", sapply(x1[-c(1, length(x1))], function(y) evaluate(x$cond_scores[[i]], x$design, y))),
                           collapse = " ")}',
                           ' | {sprintf("%5.2f", evaluate(x$cond_scores[[i]], x$design, x1[length(x1)]))}',
                           '\n\r'))
        }
    }

    if (length(x$uncond_scores) > 0) {
        for (i in 1:length(x$uncond_scores)) {
            cat(sprintf(glue::glue('%{maxlength}s: %10.3f\n\r'), names(x$uncond_scores)[i], x$uncond_scores[i]))
        }
    }
}




#' Draw samples from a two-stage design
#'
#' \code{simulate} allows to draw samples from a given
#' \code{\link{TwoStageDesign}}.
#'
#' @param object \code{TwoStageDesign} to draw samples from
#' @param nsim number of simulation runs
#' @param seed random seed
#' @param dist data distribution
#' @param theta location parameter of the data distribution
#' @template dotdotdot
#'
#' @return \code{simulate()} returns a \code{data.frame} with \code{nsim}
#' rows and for each row (each simulation run) the following columns
#'
#' * theta: The effect size
#' * n1: First-stage sample size
#' * c1f: Stopping for futility boundary
#' * c1e: Stopping for efficacy boundary
#' * x1: First-stage outcome
#' * n2: Resulting second-stage sample size after observing x1
#' * c2: Resulting second-stage decision-boundary after observing x1
#' * x2: Second-stage outcome
#' * reject: Decision whether the null hypothesis is rejected or not
#'
#' @examples
#' design <- TwoStageDesign(25, 0, 2, 25, 2, order = 5)
#' # draw samples assuming two-armed design
#' simulate(design, 10, Normal(), .3, 42)
#'
#' @seealso \code{\link{TwoStageDesign}}
#'
#' @export
setMethod("simulate", signature("TwoStageDesign", "numeric"),
          function(object, nsim, dist, theta, seed = NULL, ...){
              if (!is.null(seed))
                  set.seed(seed)

              res <- data.frame(
                  theta  = rep(theta, nsim),
                  n1     = n1(object, round = TRUE),
                  c1f    = object@c1f,
                  c1e    = object@c1e
              )

              res$x1     <- simulate(dist, nsim = nsim, n = res$n1, theta = theta)
              res$n2     <- n2(object, res$x1, round = TRUE)
              res$c2     <- c2(object, res$x1)

              res$x2     <- simulate(dist, nsim = nsim, n = res$n2, theta = theta)
              res$reject <- res$x2 > res$c2 # check > vs. >=

              return(res)
          })
