-
Notifications
You must be signed in to change notification settings - Fork 0
/
get_gof.R
52 lines (39 loc) · 1.68 KB
/
get_gof.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
#================Extract GOF measures from a model================#
get_gof <- function(mod, ...) {
UseMethod("get_gof", mod)
}
print.get_gof <- function(obj, ...) {
out <- matrix(unlist(obj), ncol = 1, dimnames = list(attr(obj, "print_names"), ""))
class(out) <- "matrix"
print(out)
}
#========lm========#
get_gof.lm <- function(mod, ...) {
smry_mod <- summary(mod)
out <- list(r_sq = smry_mod$r.squared, adj_r_sq = smry_mod$adj.r.squared, num_obs = nobs(mod))
attr(out, "print_names") <- c("R^2", "Adj. R^2", "No. Obs.")
attr(out, "decimal") <- c(TRUE, TRUE, FALSE)
class(out) <- append("get_gof", class(out))
return(out)
}
#========glm========#
get_gof.glm <- function(mod, ...) {
smry_mod <- summary(mod)
loglik_mod <- logLik(mod)
out <- list(aic = AIC(mod), bic = BIC(mod), loglik = loglik_mod[1], dev = deviance(mod), df = attr(loglik_mod, "df"), num_obs = nobs(mod))
attr(out, "print_names") <- c("AIC", "BIC", "Log likelihood", "Deviance", "DF", "No. obs.")
attr(out, "decimal") <- c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE)
class(out) <- append("get_gof", class(out))
return(out)
}
#========coxph========#
get_gof.coxph <- function(mod, ...) {
smry_mod <- summary(mod)
loglik_mod <- logLik(mod)
ph_test <- survival::cox.zph(mod)$table["GLOBAL", "p"]
out <- list(aic = AIC(mod), loglik = loglik_mod[1], df = attr(loglik_mod, "df"), num_obs = mod$n, num_events = mod$nevent, N.A. = length(mod$na.action), ph = ph_test)
attr(out, "print_names") <- c("AIC", "Log likelihood", "DF", "No. obs.", "No. events", "N.A.", "PH test")
attr(out, "decimal") <- c(TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, TRUE)
class(out) <- append("gof_smry", class(out))
return(out)
}