Nothing
### summary.ate.R ---
##----------------------------------------------------------------------
## Author: Brice Ozenne
## Created: okt 29 2019 (13:18)
## Version:
## Last-Updated: okt 26 2020 (09:39)
## By: Brice Ozenne
## Update #: 267
##----------------------------------------------------------------------
##
### Commentary:
##
### Change Log:
##----------------------------------------------------------------------
##
### Code:
## * summary.ate (documentation)
#' @title Summary Average Treatment Effects
#' @description Summary average treatment effects.
#' @name summary.ate
#'
#' @param object object obtained with function \code{ate}
#' @param type [character vector] what to displayed.
#' Can be \code{"meanRisk"} to display the risks specific to each treatment group,
#' \code{"diffRisk"} to display the difference in risks between treatment groups,
#' or \code{"ratioRisk"} to display the ratio of risks between treatment groups,.
#' @param estimator [character] The type of estimator relative to which the estimates should be displayed.
#' @param se [logical] should the standard error of the risks be displayed?
#' @param quantile [logical] should the quantile of the confidence bands be displayed?
#' @param estimate.boot [logical] should the average estimate on the bootstrap samples be displayed?
#' @param digits [integer, >0] Number of digits.
#' @param short [logical] If \code{TRUE}, only displays the estimated risks.
#' @param ... passed to confint
#'
#' @details to display confidence intervals/bands and p.value,
#' the \code{confint} method needs to be applied on the object.
#'
#' @seealso
#' \code{\link{as.data.table}} to extract the estimates in a \code{data.table} object.
#' \code{\link{autoplot.ate}} for a graphical representation the standardized risks.
#' \code{\link{confint.ate}} to compute p-values and adjusted p-values
#' or perform statistical inference using a transformation.
#' \code{\link{confint.ate}} to compute (pointwise/simultaneous) confidence intervals and (unadjusted/adjusted) p-values, possibly using a transformation.
## * print.ate (code)
#' @rdname summary.ate
#' @method summary ate
#' @export
summary.ate <- function(object, estimator = object$estimator[1], short = FALSE,
type = c("meanRisk","diffRisk"),
se = FALSE, quantile = FALSE, estimate.boot = TRUE,
digits = 3,
...){
lower <- upper <- lowerBand <- upperBand <- NULL ## [:CRANcheck:] data.table
## ** update confint
args.confint <- c("conf.level","n.sim","contrasts","allContrasts","meanRisk.transform","diffRisk.transform","ratioRisk.transform","seed",
"ci","band","p.value","method.band","alternative","bootci.method")
if(any(args.confint %in% names(list(...)))){
object[c("meanRisk","diffRisk","ratioRisk","inference","inference.allContrasts","inference.contrasts","transform")] <- confint(object,...)
}
if(!is.null(object$inference.allContrasts)){
allContrasts <- object$inference.allContrasts
contrasts <- object$inference.contrasts
}else{
contrasts <- object$contrasts
allContrasts <- utils::combn(contrasts, m = 2)
}
## ** check arguments
type <- match.arg(type,c("meanRisk","diffRisk","ratioRisk"), several.ok = TRUE)
if("diffRisk" %in% type && "ratioRisk" %in% type){
stop("Cannot simulatenously display the risk difference and the risk ratio \n")
}
estimator <- match.arg(estimator, choices = object$estimator, several.ok = FALSE)
## ** Display: specification of ate
if(short==0){
print(object, display.results = FALSE)
if(object$inference$ci || object$inference$band || object$inference$p.value){
cat("\n Testing procedure\n")
index.transform <- which(object$transform!="none")
if(length(index.transform)>0){
name.tempo <- c("mean risk","risk difference","risk ratio")
cat(" (on the ",paste(object$transform[index.transform],collapse="/")," scale for the ",paste(name.tempo[index.transform],collapse="/"),") \n",sep="")
}
if(object$inference$band == 1){
if(object$inference$alternative=="two.sided"){
cat(" - Null hypothesis : given two treatments (A,B), equal risks at all timepoints \n", sep ="")
}else if(object$inference$alternative=="greater"){
cat(" - Null hypothesis : given two treatments (A,B), \n",
" risk under B is equal or smaller than the risk under A at all timepoints \n", sep ="")
}else if(object$inference$alternative=="less"){
cat(" - Null hypothesis : given two treatments (A,B), \n",
" risk under B is equal or greater than the risk under A at all timepoints \n", sep ="")
}
}else if(object$inference$band == 2){
if(object$inference$alternative=="two.sided"){
cat(" - Null hypothesis : equal risks at all timepoints for all treatments \n", sep ="")
}else if(object$inference$alternative=="greater"){
cat(" - Null hypothesis : risks under the experimental treatments are all equal or smaller than the risks under the reference treatment(s) \n", sep ="")
}else if(object$inference$alternative=="less"){
cat(" - Null hypothesis : risks under the experimental treatments are all equal or greater than the risks under the reference treatment(s) \n", sep ="")
}
}else if(object$inference$ci){
if(object$inference$alternative=="two.sided"){
cat(" - Null hypothesis : given two treatments (A,B) and a specific timepoint, equal risks \n", sep ="")
}else if(object$inference$alternative=="greater"){
cat(" - Null hypothesis : given two treatments (A,B) and a specific timepoint, \n",
" risk under B is equal or smaller than the risk under A \n", sep ="")
}else if(object$inference$alternative=="less"){
cat(" - Null hypothesis : given two treatments (A,B) and a specific timepoint, \n",
" risk under B is equal or greater than the risk under A \n", sep ="")
}
}
cat(" - Confidence level : ", object$inference$conf.level,"\n", sep ="")
if(object$inference$band){
if(is.na(object$inference$method.band)){
cat(" - Multiple comparisons: no adjustment\n", sep ="")
}else if(object$inference$method.band=="maxT-simulation"){
cat(" - Multiple comparisons: single-step max-T adjustment computed using ", object$inference$n.sim," simulations\n", sep ="")
}else if(object$inference$method.band=="maxT-integration"){
cat(" - Multiple comparisons: single-step max-T adjustment computed using numerical intergration\n", sep ="")
}else{
cat(" - Multiple comparisons: ",object$inference$method.band," adjustment\n", sep ="")
}
}
}
}
## ## ** prepare
## txt.alternative <- switch(object$inference$alternative,
## "two.sided" = "two-sided tests, alternative: unequal risk",
## "greater" = "one-sided tests, alternative: greater risk",
## "less" = "one-sided tests, alternative: less risk")
if(short==0){
cat("\n Results: \n")
}
if(identical(type,"meanRisk")){
## ** only risks
## prepare
iIndexRow <- which((object$meanRisk$estimator == estimator) * (object$meanRisk$treatment %in% contrasts) == 1)
dt.tempo <- object$meanRisk[iIndexRow,.SD, .SDcols = setdiff(names(object$meanRisk),"estimator")]
if(!is.na(object$variable["strata"])){
setnames(dt.tempo, old = "treatment", new = object$variable["strata"])
}else if(!is.na(object$variable["treatment"])){
setnames(dt.tempo, old = "treatment", new = object$variable["treatment"])
}
if(object$inference$se && !se){
dt.tempo[,c("se") := NULL]
}
if(all(is.na(dt.tempo$time))){
dt.tempo[,c("time") := NULL]
}
setnames(dt.tempo, old = "estimate", new = "risk")
if(object$inference$bootstrap){
if(!estimate.boot){
dt.tempo[,c("estimate.boot") := NULL]
}else{
setnames(dt.tempo, old = "estimate.boot", new = "risk.boot")
}
}
if(object$inference$band && object$inference$method.band %in% c("bonferroni","maxT-integration","maxT-simulation")){
dt.tempo[,c("lowerBand") := Publish::formatCI(lower = .SD$lowerBand, upper = .SD$upperBand)]
dt.tempo[,c("upperBand") := NULL]
setnames(dt.tempo, old = "lowerBand", new = "simultaneous ci")
if(quantile==FALSE){
dt.tempo[,c("quantileBand") := NULL]
}
}
if(object$inference$ci){
dt.tempo[,c("lower") := Publish::formatCI(lower = .SD$lower, upper = .SD$upper)]
dt.tempo[,c("upper") := NULL]
setnames(dt.tempo, old = "lower", new = "ci")
}
## display
if(short == 1){
cat(" - Standardized risk between time zero and 'time'\n",sep="")
cat("\n")
print(dt.tempo, digits=digits, row.names = FALSE)
cat("\n")
}else if(short == 0){
cat(" - Standardized risk between time zero and 'time', reported on the scale [0;1] (probability scale)\n",sep="")
if(!is.na(object$variable["strata"])){
cat(" (average risk within strata)\n")
}else{
cat(" (average risk when treating all subjects with one treatment)\n",sep="")
}
cat("\n")
print(dt.tempo, digits=digits, row.names = FALSE)
cat("\n")
}
}else{
## ** difference or ratio
## prepare
if("diffRisk" %in% type){
iIndexRow <- which((object$diffRisk$estimator == estimator) * (interaction(object$diffRisk$A,object$diffRisk$B) %in% interaction(allContrasts[1,],allContrasts[2,])) == 1)
dt.tempo <- object$diffRisk[iIndexRow,.SD, .SDcols = setdiff(names(object$diffRisk),"estimator")]
}else if("ratioRisk" %in% type){
iIndexRow <- which((object$ratioRisk$estimator == estimator) * (interaction(object$ratioRisk$A,object$ratioRisk$B) %in% interaction(allContrasts[1,],allContrasts[2,])) == 1)
dt.tempo <- object$ratioRisk[iIndexRow,.SD, .SDcols = setdiff(names(object$ratioRisk),"estimator")]
}
if(!is.na(object$variable["treatment"])){
setnames(dt.tempo, old = c("A","B"), new = paste(object$variable["treatment"],c("A","B"),sep="="))
}else if(!is.na(object$variable["strata"])){
setnames(dt.tempo, old = c("A","B"), new = paste(object$variable["strata"],c("A","B"),sep="="))
}
if("meanRisk" %in% type == FALSE){
dt.tempo[,c("estimate.A","estimate.B") := NULL]
}else{
if(!is.na(object$variable["treatment"])){
setnames(dt.tempo, old = c("estimate.A","estimate.B"), new = c(paste0("risk(",object$variable["treatment"],"=A)"),paste0("risk(",object$variable["treatment"],"=B)")))
}else if(!is.na(object$variable["strata"])){
setnames(dt.tempo, old = c("estimate.A","estimate.B"), new = c("risk(",object$variable["strata"],"=A)","risk(",object$variable["strata"],"=B)"))
}
}
if("diffRisk" %in% type){
setnames(dt.tempo, old = "estimate", new = "difference")
}else if("ratioRisk" %in% type){
setnames(dt.tempo, old = "estimate", new = "ratio")
}
if(object$inference$se && !se){
dt.tempo[,c("se") := NULL]
}
if(all(is.na(dt.tempo$time))){
dt.tempo[,c("time") := NULL]
}
if(object$inference$bootstrap){
if(!estimate.boot){
dt.tempo[,c("estimate.boot") := NULL]
}else{
if("diffRisk" %in% type){
setnames(dt.tempo, old = "estimate.boot", new = "difference.boot")
}else if("ratioRisk" %in% type){
setnames(dt.tempo, old = "estimate.boot", new = "ratio.boot")
}
}
}
if(object$inference$band && object$inference$method.band %in% c("bonferroni","maxT-integration","maxT-simulation")){
dt.tempo[,c("lowerBand") := Publish::formatCI(lower = .SD$lowerBand, upper = .SD$upperBand)]
dt.tempo[,c("upperBand") := NULL]
setnames(dt.tempo, old = "lowerBand", new = "simultaneous ci")
if(quantile==FALSE){
dt.tempo[,c("quantileBand") := NULL]
}
if("adj.p.value" %in% names(dt.tempo)){
setnames(dt.tempo, old = "adj.p.value", new = "adjusted p.value")
}
}
if(object$inference$ci){
dt.tempo[,c("lower") := Publish::formatCI(lower = .SD$lower, upper = .SD$upper)]
dt.tempo[,c("upper") := NULL]
setnames(dt.tempo, old = "lower", new = "ci")
}
## display
if("diffRisk" %in% type){
if(short==0){
cat(" - Difference in standardized risk (B-A) between time zero and 'time' \n")
cat(" reported on the scale [-1;1] (difference between two probabilities)\n",sep="")
if(!is.na(object$variable["strata"])){
cat(" (difference between the average risk in two different strata)\n")
}else{
cat(" (difference in average risks when treating all subjects with the experimental treatment (B),\n",
" vs. treating all subjects with the reference treatment (A))\n")
}
cat("\n")
print(dt.tempo,digits=digits,row.names = FALSE)
cat("\n")
}else if(short==1){
cat(" - Difference in standardized risk (B-A) between time zero and 'time' \n")
cat("\n")
print(dt.tempo,digits=digits,row.names = FALSE)
cat("\n")
}
}else if("ratioRisk" %in% type){
if(short==0){
cat(" - Ratio of standardized risks (B/A) between time zero and 'time' \n")
cat(" reported on the scale ]0;1] (ratio of two probabilities)\n",sep="")
if(!is.na(object$variable["strata"])){
cat(" (ratio between the average risk in two different strata)\n")
}else{
cat(" (ratio of average risks when treating all subjects with the experimental treatment (B),\n",
" vs. treating all subjects with the reference treatment (A))\n")
}
cat("\n")
print(dt.tempo,digits=digits,row.names = FALSE)
cat("\n")
}else if(short == 1){
cat(" - Ratio of standardized risks (B/A) between time zero and 'time' \n")
cat("\n")
print(dt.tempo,digits=digits,row.names = FALSE)
cat("\n")
}
}
}
## CI/Band
if(short == 0){
if("diffRisk" %in% type){
cat(" difference : estimated difference in standardized risks \n")
if(object$inference$bootstrap && estimate.boot){
cat(" difference.boot : average value over the bootstrap samples \n")
}
}else if("ratioRisk" %in% type){
cat(" ratio : estimated ratio between standardized risks \n")
if(object$inference$bootstrap && estimate.boot){
cat(" ratio.boot : average value over the bootstrap samples \n")
}
}else{
cat(" risk : estimated standardized risk \n")
if(object$inference$bootstrap && estimate.boot){
cat(" risk.boot : average value over the bootstrap samples \n")
}
}
if(object$inference$ci){
cat(" ci : pointwise confidence intervals \n")
if(object$inference$p.value && any(c("diffRisk","ratioRisk") %in% type)){
cat(" p.value : (unadjusted) p-value \n")
}
}
if(object$inference$band && object$inference$method.band %in% c("bonferroni","maxT-integration","maxT-simulation")){
if(object$inference$band==1){
cat(" simultaneous ci : simulatenous confidence intervals over time\n")
}else if(object$inference$band==2){
cat(" simulatenous ci : simulatenous confidence intervals over time and treatment\n")
}
}
if(object$inference$p.value && object$inference$band && any(c("diffRisk","ratioRisk") %in% type)){
if(object$inference$band==1){
cat(" adjusted p.value: p-value adjusted for multiple comparisons over time\n")
}else if(object$inference$band==2){
cat(" adjusted p.value: p-value adjusted for multiple comparisons over time and treatment\n")
}
}
}
## export
return(invisible(object))
}
######################################################################
### summary.ate.R ends here
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.