R/print.tvcure.R

In tvcure: Additive Cure Survival Model with Time-Varying Covariates

#' Print summary information on a \code{tvcure.object}.
#'
#' @description
#' Print summary information on a \code{tvcure.object} generated by \code{\link{tvcure}}.
#'
#' @usage \method{print}{tvcure}(x, ci.level=.95,expEst=TRUE,
#'              digits.est=3,digits.edf=2,digits.tst=2,digits.Pvalue=3,...)
#'
#' @param x an object of class \code{\link{tvcure.object}}.
#' @param ci.level (optional) nominal level for the plotted pointwise credible intervals (default: .95).
#' @param expEst (optional) logical indicating if the exponential of the regression parameter estimates should also be provided (with their confidence interval) (default: TRUE).
#' @param digits.est number of digits when reporting parameter estimates (default: 3).
#' @param digits.edf number of digits when reporting effective degrees of freedom (default: 2).
#' @param digits.tst number of digits when reporting test statistics (default: 2).
#' @param digits.Pvalue number of digits when reporting P-values (default: 3).
#' @param ... additional generic printing arguments.
#'
#' @details Provides summary measures on the estimation of the regression parameters and additive terms
#' in the tvcure model corresponding to a \code{\link{tvcure.object}} generated by \code{\link{tvcure}}.
#'
#' @return No returned value (just printed summary).
#'
#' @author Philippe Lambert \email{p.lambert@uliege.be}
#' @references Lambert, P. and Kreyenfeld, M. (2025).
#' Time-varying exogenous covariates with frequently changing values in double additive cure survival model: an application to fertility.
#' \emph{Journal of the Royal Statistical Society, Series A}. <doi:10.1093/jrsssa/qnaf035>
#'
#' @examples
#' \donttest{
#' require(tvcure)
#' ## Simulated data generation
#' beta = c(beta0=.4, beta1=-.2, beta2=.15) ; gam = c(gam1=.2, gam2=.2)
#' data = simulateTVcureData(n=500, seed=123, beta=beta, gam=gam,
#'                           RC.dist="exponential",mu.cens=550)$rawdata
#' ## TVcure model fitting
#' tau.0 = 2.7 ; lambda1.0 = c(40,15) ; lambda2.0 = c(25,70) ## Optional
#' model = tvcure(~z1+z2+s(x1)+s(x2), ~z3+z4+s(x3)+s(x4), data=data,
#'                tau.0=tau.0, lambda1.0=lambda1.0, lambda2.0=lambda2.0)
#' print(model)
#' }
#'
#' @seealso \code{\link{tvcure}}, \code{\link{tvcure.object}}, \code{\link{plot.tvcure}}
#'
#' @export
#'
print.tvcure <- function(x,ci.level=.95,expEst=TRUE,
                         digits.est=3,digits.edf=2,digits.tst=2,digits.Pvalue=3,...){
    eps.Pvalue = 10^(-digits.Pvalue)
    obj = x
    printMat = function(mat,cs.est=NULL,cs.tst=NULL,cs.edf=NULL,cs.Pval=NULL){
        clnms = colnames(mat)
        mat = data.frame(mat)
        colnames(mat) = clnms
        if (!is.null(cs.est)){
            idx = cs.est ## Columns with parameter estimates
            mat[,idx] = round(mat[,idx],digits.est)
        }
        if (!is.null(cs.edf)){
            idx = cs.edf ## Columns with EDF
            mat[,idx] = round(mat[,idx],digits.edf)
        }
        if (!is.null(cs.tst)){
            idx = cs.tst ## Columns with test stats
            mat[,idx] = round(mat[,idx],digits.tst)
        }
        if (!is.null(cs.Pval)){
            Signif = symnum(as.vector(mat[,ncol(mat)]), ## Signif stars
                            corr = FALSE, na = FALSE,
                            cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1),
                            symbols = c("***", "**", "*", ".", " "))
            idx = cs.Pval ## Columns with Pvalues
            mat0 = mat[,idx]
            mat0 = round(mat[,idx],digits.Pvalue)
            idx0 =  (mat0 < eps.Pvalue)
            mat0 = format(mat0,scientific=FALSE)
            mat0[idx0] = paste("<",format(eps.Pvalue,scientific=FALSE),sep="")
            mat[,idx] = mat0
            mat = cbind(mat, format(as.vector(Signif))) ## Add stars
            colnames(mat)[ncol(mat)] = ""
        }
        print(mat)
    }
    cat("\nCall:\n")
    print(x$call)
    cat("\n")
    ##
    if (obj$regr1$J>0 || obj$regr2$J>0){
        with(obj$fit, cat("Prior on penalty parameter(s): Gamma(",a,",",b,")\n\n",sep=""))
    }
    cat(">> log(theta(x)) - Long-term survival (Quantum) <<\n")
    cat("Formula:",deparse(obj$formula1),"\n")
    nfixed1 = obj$regr1$nfixed
    cat("\nParametric coefficients:\n")
    mat = obj$fit$beta[1:nfixed1,,drop=FALSE]
    printMat(mat,cs.est=1:4,cs.tst=5,cs.Pval=6)
    ##
    if (expEst & nfixed1 > 1){ ## Print exp(est)
        cat("\n")
        mat = with(obj$fit, cbind("exp(est)"=exp(beta[,"est"]),
                                  "exp(-est)"=exp(-beta[,"est"]),
                                  low=exp(beta[,"low"]),
                                  up=exp(beta[,"up"]),
                                  Pval=beta[,"Pval"]))
        printMat(mat[2:nfixed1,,drop=FALSE],cs.est=1:4,,cs.Pval=5)
    }
    ##
    if (obj$regr1$J > 0){
        if (obj$fit$marginalized){
            cat("\nApproximate significance of smooth terms (Wood's <Tr> or Chi2):\n")
            ## printMat(obj$fit$ED1,cs.edf=1:3,cs.tst=c(5,7),cs.Pval=c(4,6,8))
            printMat(obj$fit$ED1,cs.edf=1:3,cs.tst=c(5,7),cs.Pval=c(4,6,8))
        } else {
            cat("\nApproximate significance of smooth terms (Wood's <Tr> or Chi2):\n")
            ## printMat(obj$fit$ED1,cs.edf=1,cs.tst=c(2,4,6),cs.Pval=c(3,5,7))
            printMat(obj$fit$ED1,cs.edf=1,cs.tst=c(2,4),cs.Pval=c(3,5))
        }
    }
    ##
    cat("\n>> eta(x) - Short-term survival (Timing) <<\n")
    ## switch(obj$baseline,
    ##        "S0" = {
    ##            cat("S.p(t|x) = exp{-theta(x) F(t|x)}  where  1-F(t|x) = S(t|x) = S.0(t)^exp(eta(x))\n")
    ##        },
    ##        "F0" = {
    ##            cat("S.p(t|x) = exp{-theta(x) F(t|x)}  where  F(t|x) = F.0(t)^exp(eta(x))\n")
    ##        }
    ## )
    cat("Formula:",deparse(obj$formula2),"\n")
    nfixed2 = obj$regr2$nfixed
    cat("\nParametric coefficients:\n")
    if (nfixed2 == 0){
        cat("No intercept or linear term \n")
    } else {
        mat = obj$fit$gamma[1:obj$regr2$nfixed,,drop=FALSE]
        printMat(mat,cs.est=1:4,cs.tst=5,cs.Pval=6)

    }
    ##
    if (expEst & nfixed2 > 0){ ## Print exp(est)
        cat("\n")
        mat = with(obj$fit, cbind("exp(est)"=exp(gamma[,"est"]),
                                  "exp(-est)"=exp(-gamma[,"est"]),
                                  low=exp(gamma[,"low"]),
                                  up=exp(gamma[,"up"]),
                                  Pval=gamma[,"Pval"]) )
        printMat(mat[1:nfixed2,,drop=FALSE],cs.est=1:4,,cs.Pval=5)

    }
    ##
    if (obj$regr2$J > 0){
        if (obj$fit$marginalized){
            cat("\nApproximate significance of smooth terms (Wood's <Tr> or Chi2):\n")
            ## printMat(obj$fit$ED2,cs.edf=1:3,cs.tst=c(5,7),cs.Pval=c(4,6,8))
            printMat(obj$fit$ED2,cs.edf=1:3,cs.tst=c(5,7),cs.Pval=c(4,6,8))
        } else {
            cat("\nApproximate significance of smooth terms (Wood's <Tr> or Chi2):\n")
            ## printMat(obj$fit$ED2,cs.edf=1,cs.tst=c(2,4,6),cs.Pval=c(3,5,7))
            printMat(obj$fit$ED2,cs.edf=1,cs.tst=c(2,4),cs.Pval=c(3,5))
        }
    }
    cat("\n---------------------------------------------------------------\n")
    if (!(obj$fit$marginalized)) cat(" logEvid: ",round(obj$fit$logEvid,2)," ",sep="")
    cat(" Dev:",round(obj$fit$dev,2),
        "  AIC:",round(obj$fit$AIC,2),
        "  BIC:",round(obj$fit$BIC,2),
        "\n")
    cat(" edf: ",round(obj$fit$ED.tot,2),
        "   nobs: ",obj$fit$nobs,
        "   n: ",obj$fit$n," (units)",
        "   d: ",obj$fit$d," (events)",
        "\n",sep="")
    cat(" Convergence: ",obj$fit$converged,"  --  Algorithms: NR-",obj$fit$tau.method," / ",obj$fit$psi.method,"-",obj$fit$lambda.method,"\n",sep="")
    cat(" Elapsed time: ",round(obj$fit$elapsed.time,1)," seconds  (",obj$fit$iter," iterations)\n",sep="")
    cat("---------------------------------------------------------------\n")
}