sahirbhatnagar / casebase
1 2
estimate_hazard <- function(object, ...) UseMethod("estimate_hazard")
2

3
estimate_hazard.default <- function(object, ...) {
4 0
    stop(paste("This function should be used with an object of class",
5 0
               "glm, cv.glmnet, gbm"),
6 0
         call. = TRUE)
7
}
8

9
estimate_hazard.glm <- function(object, newdata, ci = FALSE, plot = FALSE,
10
                                ci.lvl = 0.95, ...) {
11 2
    check_arguments_hazard(object, newdata, plot, ci, ci.lvl)
12
    # Set offset to zero
13 2
    newdata$offset <- 0
14
    # Silence warnings about splines at t=0
15 2
    withCallingHandlers(pred <- predict(object, newdata, se.fit = ci,
16 2
                                        type = "link"),
17 2
                        warning = handler_bsplines)
18 2
    return(pred)
19
}
20

21
# The next function below makes the following assumption:
22
# Either time is already part of newdata (if it's a matrix)
23
# Or it's part of object$formula and will be added to newdata when we expand.
24
# Therefore, we need to make sure that assumption is verified before calling it.
25
estimate_hazard.cv.glmnet <- function(object, newdata, ci = FALSE, plot = FALSE,
26
                                      ci.lvl = 0.95, s = c("lambda.1se",
27
                                                           "lambda.min"), ...) {
28 2
    check_arguments_hazard(object, newdata, plot, ci, ci.lvl)
29 2
    if (is.numeric(s)) {
30 2
        if (length(s) > 1) {
31 0
            warning(paste("More than one value for s has been supplied.",
32 0
                          "Only first entry will be used"))
33
            }
34 2
        s <- s[1]
35 2
    } else if (is.character(s)) {
36 2
        s <- match.arg(s)
37
    }
38 2
    if (!inherits(newdata, "matrix")) {
39
        # Remove response variable because it won't be in newdata
40 2
        formula_pred <- formula(delete.response(terms(object$formula)))
41 2
        newdata_matrix <- prepareX(formula_pred, newdata)
42
    } else {
43 2
        newdata_matrix <- newdata
44
    }
45 2
    pred <- predict(object, newdata_matrix, s, newoffset = 0)
46

47 2
    return(pred)
48
}
49

50
estimate_hazard.gbm <- function(object, newdata, ci = FALSE, plot = FALSE,
51
                                ci.lvl = 0.95, n.trees, s = NULL, ...) {
52 2
    check_arguments_hazard(object, newdata, plot, ci, ci.lvl)
53
    # If gbm was fitted with an offset, predict.gbm ignores it
54
    # but still gives a warning. The following line silences this warning
55 2
    attr(object$Terms, "offset") <- NULL
56
    # Set offset to zero
57 2
    newdata$offset <- 0
58 2
    withCallingHandlers(pred <- predict(object, newdata, type = "link",
59 2
                                        n.trees, ...),
60 2
                        warning = handler_offset)
61 2
    return(pred)
62
}
63

64
check_arguments_hazard <- function(object, newdata, plot, ci, ci.lvl) {
65
    # For hazardPlot, we only want one row in newdata
66
    # for hazard ratio plot, we can have more than one row in newdata so
67
    # set plot = FALSE for hazard ratio plots in plot.singleEventCB function
68 2
    if (nrow(newdata) > 1 && plot) {
69 0
        newdata <- newdata[1, , drop = FALSE]
70 0
        warning(paste("More than 1 row supplied to 'newdata'.",
71 0
                      "Only the first row will be used."))
72
    }
73 2
    if (ci) {
74 2
        if (!data.table::between(ci.lvl, 0, 1, incbounds = FALSE))
75 0
            stop("ci.lvl must be between 0 and 1")
76 2
        if (!inherits(object, "glm")) {
77 0
            warning(sprintf(paste("Confidence intervals cannot be calculated",
78 0
                                  "for objects of class %s."),
79 0
                            class(object)[1]))
80 0
            ci <- FALSE
81
        }
82 2
        if (any(names(newdata) %in% c("standarderror", "lowerbound",
83 2
                                      "upperbound", "hazard_ratio",
84 2
                                      "log_hazard_ratio"))) {
85 0
            stop(paste("'standarderror','lowerbound', 'upperbound',",
86 0
                       "'hazard_ratio' and 'log_hazard_ratio' cannot be used",
87 0
                       "as column names in newdata. Rename it."))
88
        }
89
    } else {
90 2
        if (any(names(newdata) %in% c("hazard_ratio", "log_hazard_ratio")))
91 0
            stop(paste("'hazard_ratio' and 'log_hazard_ratio' cannot be used",
92 0
                       "as column names in newdata. Rename it."))
93
    }
94

95

96 2
    invisible(NULL)
97
}

Read our documentation on viewing source code .

Loading