R/print.parfm.R

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
################################################################################
#  Print method for class 'parfm'                                              #
################################################################################
#                                                                              #
#  This function prints the objects of class 'parfm'                           #
#                                                                              #
#  Its parameters are                                                          #
#   - x         : the fitted model, object of class 'parfm'                    #
#   - digits    : number of significant digits                                 #
#   - na.prints : character string indicating NA values in printed output      #
#                                                                              #
#                                                                              #
#                                                                              #
#  The function returns                                                        #
#   - a header like                                                            #
#                                                                              #
#       Frailty distribution: Positive Stable                                  #
#       Baseline hazard distribution: Gompertz                                 #
#       Loglikelihood: -357.113                                                #
#                                                                              #
#   - estimated values in a table like                                         #
#                                                                              #
#              ESTIMATE SE     p-val                                           #
#       gamma   0.000    0.000                                                 #
#       lambda  0.035   13.329                                                 #
#       sex    -0.951    0.348 0.008 **                                        #
#       age     0.004    0.011 0.692                                           #
#       theta   0.888    0.084                                                 #
#       ---                                                                    #
#       Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1          #
#                                                                              #
#                                                                              #
#   Date: December 19, 2011                                                    #
#   Last modification: January 23, 2017                                        #
################################################################################

print.parfm <- function(x,
                        digits = 3,
                        na.print = "",
                        silent = FALSE,
                        ...) {
    if (!is.null(x)) {
        # Which frailty distribution, pretty expression
        frailty <- list(none      = "none",
                        gamma     = "gamma",
                        possta    = "positive stable",
                        ingau     = "inverse Gaussian",
                        lognormal = "lognormal")[paste(attributes(x)$frailty)]
        
        # Kendall's Tau
        tau <- tau(x)
        
        # Which baseline hazard, pretty expression
        baseline <- paste(toupper(substr(attributes(x)$dist, 1, 1)), 
                          substr(attributes(x)$dist, 2, 100), 
                          sep = "")
        
        # Loglikelihood value
        loglikelihood <- round(attributes(x)$loglik, digits)
        
        x <- as.data.frame(x)
        
        # Significance of regression parameters with symbols
        if ("p-val" %in% colnames(x)) {
            signif <- symnum(x$"p-val", 
                             c(0, .001, .01, .05, .1, 1),
                             c('***', '**', '*', '.', ''), na = '')
        }
        
        # Object to printed out
        toprint <- round(x, digits)
        if ("p-val" %in% colnames(x)) {
            toprint$"p-val"[toprint$"p-val" < 10 ^ (-digits)] <- 
                paste0(c('<.', rep(0, digits - 1), '1'), collapse = '')
            toprint <- cbind(toprint, signif)
            names(toprint)[length(names(toprint))] = ""
        }
        
        # Output
        if (silent) 
            return(toprint)
        else {
            cat(paste("\nFrailty distribution:", 
                      frailty,
                      "\nBaseline hazard distribution:",
                      baseline,
                      "\nLoglikelihood:", 
                      loglikelihood,
                      "\n\n"))
            print(as.matrix(toprint), na.print = na.print, quote = FALSE)
            if ("p-val" %in% colnames(x))
                cat("---\nSignif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n")
            if (!is.null(tau))
                cat(paste("\nKendall's Tau:", 
                          ifelse(is.numeric(tau), round(tau, digits), tau), "\n"))
        }
    }
}

coef.parfm <- function(object, ...) {
    object[!is.na(object[, 'p-val']), 'ESTIMATE']
}

Questions? Problems? Suggestions? or email at ian@mutexlabs.com.

Please suggest features or report bugs with the GitHub issue tracker.

All documentation is copyright its authors; we didn't write any of that.