R/output_functions.R

In gsearly: Creates Group Sequential Trial Designs when Early Outcomes are Available

#-------------------------------------------------------------------------------
# Output functions for gsearly
#-------------------------------------------------------------------------------
# 1st July 2026
#-------------------------------------------------------------------------------

#-------------------------------------------------------------------------------
# 23.  print.gsearly
#-------------------------------------------------------------------------------
print.gsearly <- function(x, digits = 4, ...) {
  cat("\n")
  cat(x$title, "\n")
  cat("\nCall:\n", paste(deparse(x$call), sep = "\n", collapse = "\n"),
    "\n\n", sep = "")
  cat("\n")
  if (length(x$rdata$n)) {
    cat("Sample size", ", vphi = ", x$rdata$vphi, ":", "\n", sep = "")
    print.default(format(x$rdata$n, digits = digits), print.gap = 2L,
      quote = FALSE, right = TRUE)
  } else {
    cat("No interims", "\n")
  }
  cat("\n")
  if (length(x$power$totalerror)) {
    cat("Total probability:", "\n")
    print.default(format(x$power$totalerror, digits = digits), print.gap = 2L,
      quote = FALSE, right = TRUE)
  } else {
    cat("No total error", "\n")
  }
  cat("\n")
  invisible(x)
}
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------

#-------------------------------------------------------------------------------
# 24.  print.summary.gsearly
#-------------------------------------------------------------------------------
print.summary.gsearly <- function(x, digits = 4, ...) {
  cat("\n")
  cat(x$title, "\n")
  cat("\n")
  ## Recruitment model
  if (!is.na(x$rdata$m)) {
    cat("Recruitment model: ", x$rdata$rmodel, ", m = ", x$rdata$m,
      "\n", sep = "")
  } else {
    cat("Recruitment model:", x$rdata$rmodel, "\n")
  }
  cat("Time: ", x$rdata$trecruit, ", Follow-up times: ", paste(x$rdata$tfu$tfu,
    collapse = " "), "\n", sep = "")
  if (length(x$rdata$intnumbers)) {
    cat("Numbers at Interims:", "\n")
    print.default(format(x$rdata$intnumbers, digits = digits), print.gap = 2L,
      quote = FALSE, right = TRUE)
  } else {
    cat("No Interims", "\n")
  }
  if (length(x$rdata$n)) {
    cat("Sample size", ", vphi = ", x$rdata$vphi, ":", "\n", sep = "")
    print.default(format(x$rdata$n, digits = digits), print.gap = 2L,
      quote = FALSE, right = TRUE)
  } else {
    cat("No interims", "\n")
  }
  cat("\n")
  ## Information
  if (!is.na(x$idata$cmodel$rho)) {
    cat("Correlation model: ", x$idata$cmodel$type, paste(", rho =",
      x$idata$cmodel$rho), "\n", sep = "")
  } else {
    cat("Correlation model:", x$idata$cmodel$type, "\n")
    cat("Matrix:", "\n")
    print.default(format(x$idata$cmodel$corrmat, digits = digits),
      print.gap = 2L, quote = FALSE, right = TRUE)
  }
  if (length(x$idata$inform)) {
    cat("Information at interims", ", sd = ", x$idata$sd, ":", "\n",
      sep = "")
    print.default(format(x$idata$inform, digits = digits), print.gap = 2L,
      quote = FALSE, right = TRUE)
  } else {
    cat("No interims", "\n")
  }
  cat("\n")
  ## Power
  if (!is.na(x$power$setpow)) {
    cat("Power for effect size (theta): ", x$power$theta, ", Target power: ",
      format(x$power$setpow, digits = digits), "\n", sep = "")
  } else {
    cat("Power for effect size (theta): ", x$power$theta, "\n", sep = "")
  }
  if (length(x$power$lowerror) & length(x$power$upperror)) {
    cat("Probabilities and bounds:", "\n")
    ul_errors <- rbind(x$power$upperror, fp = x$power$fp, x$power$lowerror,
      tn = x$power$tn)
    ul_errors <- zapsmall(ul_errors, digits = digits)
    rownames(ul_errors) <- paste(rep(c("u", "l"), each = 3), rownames(ul_errors),
      sep = ".")
    print.default(format(ul_errors, digits = digits, scientific = FALSE),
      print.gap = 2L, quote = FALSE, right = TRUE)
  } else {
    cat("No bounds or errors", "\n")
  }
  if (length(x$power$totalerror)) {
    cat("Total probability:", "\n")
    print.default(format(x$power$totalerror, digits = digits), print.gap = 2L,
      quote = FALSE, right = TRUE)
  } else {
    cat("No total error", "\n")
  }
  cat("\n")
  invisible(x)
}
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------

#-------------------------------------------------------------------------------
# 34.  summary.gsearly
#-------------------------------------------------------------------------------
summary.gsearly <- function(object, ...) {
  attr(object, "class") <- "summary.gsearly"
  return(object)
}
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------

#-------------------------------------------------------------------------------
# end
#-------------------------------------------------------------------------------