No flags found
Use flags to group coverage reports by test type, project and/or folders.
Then setup custom commit statuses and notifications for each flag.
e.g., #unittest #integration
#production #enterprise
#frontend #backend
e1ee803
... +0 ...
e9a4ac7
Use flags to group coverage reports by test type, project and/or folders.
Then setup custom commit statuses and notifications for each flag.
e.g., #unittest #integration
#production #enterprise
#frontend #backend
16 | 16 | #' family = "gaussian", cor.type = "exchangeable") |
|
17 | 17 | #' @rdname geeUni |
|
18 | 18 | #' @importFrom geepack geeglm |
|
19 | - | #' @importFrom stats as.formula |
|
19 | + | #' @importFrom stats as.formula update |
|
20 | 20 | #' @export |
|
21 | 21 | ||
22 | 22 | ||
23 | - | geeUni = function(y, x, data, id.vec, family, cor.type = "exchangeable"){ |
|
23 | + | geeUni <- function(y, x, data, id.vec, family, cor.type = "exchangeable"){ |
|
24 | 24 | form <- as.formula(paste(y, "~", x)) |
|
25 | 25 | res <- geepack::geeglm(form, data = data, family = family, id = id.vec, corstr = cor.type) |
|
26 | 26 | coef <- summary(res)$coefficients[-1, -3] |
47 | 47 | #' @export |
|
48 | 48 | ||
49 | 49 | ||
50 | - | geeExp = function(gee.coef, family ="binomial", dec){ |
|
50 | + | geeExp <- function(gee.coef, family ="binomial", dec){ |
|
51 | 51 | if (family == "binomial"){ |
|
52 | 52 | OR <- paste(round(exp(gee.coef[,1]), dec), " (", round(exp(gee.coef[,1] - 1.96*gee.coef[,2]), dec), ",", round(exp(gee.coef[,1] + 1.96*gee.coef[,2]), dec),")", sep="") |
|
53 | 53 | return(cbind(OR, gee.coef[,3])) |
81 | 81 | #' @rdname geeglm.display |
|
82 | 82 | #' @export |
|
83 | 83 | #' @importFrom data.table data.table |
|
84 | - | #' @importFrom stats complete.cases |
|
84 | + | #' @importFrom stats complete.cases update formula |
|
85 | 85 | ||
86 | - | geeglm.display = function(geeglm.obj, decimal = 2){ |
|
86 | + | geeglm.display <- function(geeglm.obj, decimal = 2){ |
|
87 | 87 | family.gee <- geeglm.obj$family[[1]] |
|
88 | 88 | corstr.gee <- geeglm.obj$corstr |
|
89 | 89 | y <- as.character(geeglm.obj$terms[[2]]) |
|
90 | 90 | xs <- names(geeglm.obj$model)[-1] |
|
91 | 91 | ## rownames |
|
92 | 92 | geeglm.obj$data <- data.table::data.table(geeglm.obj$data) |
|
93 | - | nomiss <- stats::complete.cases(geeglm.obj$data[, c(y, xs), with = F]) |
|
94 | - | gee.uni.list <- lapply(xs, function(x){geeUni(y, x, data = geeglm.obj$data[nomiss, ], id.vec = geeglm.obj$id, family = family.gee, cor.type = corstr.gee)}) |
|
93 | + | #nomiss <- stats::complete.cases(geeglm.obj$data[, c(y, xs), with = F]) |
|
94 | + | basemodel <- stats::update(geeglm.obj, stats::formula(paste(c(". ~ .", xs), collapse=' - ')), data = geeglm.obj$data) |
|
95 | + | #gee.uni.list <- lapply(xs, function(x){geeUni(y, x, data = geeglm.obj$data[nomiss, ], id.vec = geeglm.obj$id, family = family.gee, cor.type = corstr.gee)}) |
|
96 | + | gee.uni.list <- lapply(xs, function(x){summary(stats::update(basemodel, stats::formula(paste0(". ~ . +", x)), data = geeglm.obj$data))$coefficients[-1, -3]}) |
|
95 | 97 | rn.uni <- lapply(gee.uni.list, rownames) |
|
96 | 98 | gee.uni <- Reduce(rbind, gee.uni.list) |
|
97 | 99 |
11 | 11 | #' @importFrom stats pnorm |
|
12 | 12 | ||
13 | 13 | ||
14 | - | lmerExp = function(lmer.coef, family ="binomial", dec){ |
|
14 | + | lmerExp <- function(lmer.coef, family ="binomial", dec){ |
|
15 | 15 | if (class(lmer.coef)[1] == "numeric"){ |
|
16 | - | lmer.coef = t(data.frame(lmer.coef)) |
|
16 | + | lmer.coef <- t(data.frame(lmer.coef)) |
|
17 | 17 | } |
|
18 | - | pv = 2*(1-pnorm(abs(lmer.coef[,3]))) |
|
18 | + | pv <- 2*(1-pnorm(abs(lmer.coef[,3]))) |
|
19 | 19 | if (family == "binomial"){ |
|
20 | - | OR = paste(round(exp(lmer.coef[,1]), dec), " (", round(exp(lmer.coef[,1] - 1.96*lmer.coef[,2]), dec), ",", round(exp(lmer.coef[,1] + 1.96*lmer.coef[,2]), dec),")", sep="") |
|
20 | + | OR <- paste(round(exp(lmer.coef[,1]), dec), " (", round(exp(lmer.coef[,1] - 1.96*lmer.coef[,2]), dec), ",", round(exp(lmer.coef[,1] + 1.96*lmer.coef[,2]), dec),")", sep="") |
|
21 | 21 | return(cbind(OR, pv)) |
|
22 | 22 | } else if (family %in% c(NULL, "gaussian")){ |
|
23 | - | coeff = paste(round(lmer.coef[,1], dec), " (", round(lmer.coef[,1] - 1.96*lmer.coef[,2], dec), ",", round(lmer.coef[,1] + 1.96*lmer.coef[,2], dec), ")", sep="") |
|
23 | + | coeff <- paste(round(lmer.coef[,1], dec), " (", round(lmer.coef[,1] - 1.96*lmer.coef[,2], dec), ",", round(lmer.coef[,1] + 1.96*lmer.coef[,2], dec), ")", sep="") |
|
24 | 24 | return(cbind(coeff, pv)) |
|
25 | 25 | } else if (family %in% c("poisson", "quasipoisson")){ |
|
26 | - | RR = paste(round(exp(lmer.coef[,1]), dec), " (", round(exp(lmer.coef[,1] - 1.96*lmer.coef[,2]), dec), ",", round(exp(lmer.coef[,1] + 1.96*lmer.coef[,2]), dec),")", sep="") |
|
26 | + | RR <- paste(round(exp(lmer.coef[,1]), dec), " (", round(exp(lmer.coef[,1] - 1.96*lmer.coef[,2]), dec), ",", round(exp(lmer.coef[,1] + 1.96*lmer.coef[,2]), dec),")", sep="") |
|
27 | 27 | return(cbind(RR, pv)) |
|
28 | 28 | } |
|
29 | 29 | } |
50 | 50 | #' @rdname lmer.display |
|
51 | 51 | #' @export |
|
52 | 52 | #' @importFrom lme4 lmer glmer confint.merMod |
|
53 | + | #' @importFrom stats update formula |
|
53 | 54 | ||
54 | - | lmer.display = function(lmerMod.obj, dec = 2, ci.ranef = F){ |
|
55 | - | sl = summary(lmerMod.obj) |
|
56 | - | fixef = sl$coefficients[-1,] |
|
55 | + | lmer.display <- function(lmerMod.obj, dec = 2, ci.ranef = F){ |
|
56 | + | sl <- summary(lmerMod.obj) |
|
57 | + | fixef <- sl$coefficients[-1,] |
|
57 | 58 | ||
58 | - | mdata = lmerMod.obj@frame |
|
59 | - | forms = as.character(sl$call[[2]]) |
|
60 | - | y = forms[2] |
|
61 | - | xfr = strsplit(forms[3]," \\+ ")[[1]] |
|
62 | - | xr = xfr[grepl("\\|", xfr)] |
|
63 | - | xf = xfr[!grepl("\\|", xfr)] |
|
64 | - | family.lmer = ifelse(is.null(sl$family), "gaussian", sl$family) |
|
65 | - | uni.res = "" |
|
66 | - | if (family.lmer == "gaussian"){ |
|
67 | - | unis = lapply(xf, function(x){summary(lmer(as.formula(paste(y, "~", x," + ", paste(xr, collapse =" + "), sep="")), data = mdata))$coefficients}) |
|
68 | - | unis2 = Reduce(rbind, unis) |
|
69 | - | uni.res <- unis2[rownames(unis2) != "(Intercept)",] |
|
70 | - | } else{ |
|
71 | - | unis = lapply(xf, function(x){summary(glmer(as.formula(paste(y, "~", x," + ", paste(xr, collapse =" + "), sep="")), data = mdata, family = family.lmer))$coefficients}) |
|
72 | - | unis2 = Reduce(rbind, unis) |
|
73 | - | uni.res <- unis2[rownames(unis2) != "(Intercept)",] |
|
74 | - | } |
|
59 | + | mdata <- lmerMod.obj@frame |
|
60 | + | forms <- as.character(sl$call[[2]]) |
|
61 | + | y <- forms[2] |
|
62 | + | xfr <- strsplit(forms[3]," \\+ ")[[1]] |
|
63 | + | xr <- xfr[grepl("\\|", xfr)] |
|
64 | + | xf <- xfr[!grepl("\\|", xfr)] |
|
65 | + | family.lmer <- ifelse(is.null(sl$family), "gaussian", sl$family) |
|
66 | + | uni.res <- "" |
|
67 | + | basemodel <- update(lmerMod.obj, stats::formula(paste(c(". ~ .", xf), collapse=' - ')), data = mdata) |
|
68 | + | unis <- lapply(xf, function(x){summary(stats::update(basemodel, stats::formula(paste0(". ~ . +", x)), data = mdata))$coefficients}) |
|
69 | + | unis2 <- Reduce(rbind, unis) |
|
70 | + | uni.res <- unis2[rownames(unis2) != "(Intercept)",] |
|
71 | + | ||
75 | 72 | ||
76 | 73 | if(length(xf) == 1){ |
|
77 | - | fix.all = lmerExp(uni.res, family=family.lmer, dec = dec) |
|
78 | - | family.label = colnames(fix.all)[1] |
|
79 | - | colnames(fix.all) = c(paste(family.label, "(95%CI)",sep = ""), "P value") |
|
80 | - | rownames(fix.all) = rownames(sl$coefficients)[-1] |
|
74 | + | fix.all <- lmerExp(uni.res, family=family.lmer, dec = dec) |
|
75 | + | family.label <- colnames(fix.all)[1] |
|
76 | + | colnames(fix.all) <- c(paste(family.label, "(95%CI)",sep = ""), "P value") |
|
77 | + | rownames(fix.all) <- rownames(sl$coefficients)[-1] |
|
81 | 78 | } else{ |
|
82 | - | fix.all = cbind(lmerExp(uni.res, family=family.lmer, dec = dec), lmerExp(fixef, family=family.lmer, dec = dec)) |
|
83 | - | family.label = colnames(fix.all)[1] |
|
84 | - | colnames(fix.all) = c(paste("crude ", family.label, "(95%CI)",sep = ""), "crude P value", paste("adj. ", family.label, "(95%CI)",sep = ""), "adj. P value") |
|
85 | - | rownames(fix.all) = rownames(sl$coefficients)[-1] |
|
79 | + | fix.all <- cbind(lmerExp(uni.res, family=family.lmer, dec = dec), lmerExp(fixef, family=family.lmer, dec = dec)) |
|
80 | + | family.label <- colnames(fix.all)[1] |
|
81 | + | colnames(fix.all) <- c(paste("crude ", family.label, "(95%CI)",sep = ""), "crude P value", paste("adj. ", family.label, "(95%CI)",sep = ""), "adj. P value") |
|
82 | + | rownames(fix.all) <- rownames(sl$coefficients)[-1] |
|
86 | 83 | } |
|
87 | 84 | ||
88 | - | ranef = data.frame(sl$varcor)[,c(1,4)] |
|
89 | - | ranef.out = cbind(as.character(round(ranef[,2], dec)), matrix(NA, nrow(ranef), ncol(fix.all) - 1 )) |
|
90 | - | rownames(ranef.out) = ranef[,1] |
|
85 | + | ranef <- data.frame(sl$varcor)[,c(1,4)] |
|
86 | + | ranef.out <- cbind(as.character(round(ranef[,2], dec)), matrix(NA, nrow(ranef), ncol(fix.all) - 1 )) |
|
87 | + | rownames(ranef.out) <- ranef[,1] |
|
91 | 88 | if (ci.ranef){ |
|
92 | - | ranef.ci = confint.merMod(lmerMod.obj, parm = 1:nrow(ranef), oldNames = F)^2 |
|
93 | - | ranef.paste = paste(round(ranef$vcov, dec)," (", round(ranef.ci[,1], dec), ",", round(ranef.ci[,2], dec),")", sep="") |
|
94 | - | ranef.out = cbind(ranef.paste, matrix(NA, nrow(ranef), 3)) |
|
95 | - | rownames(ranef.out) = ranef[,1] |
|
89 | + | ranef.ci <- confint.merMod(lmerMod.obj, parm = 1:nrow(ranef), oldNames = F)^2 |
|
90 | + | ranef.paste <- paste(round(ranef$vcov, dec)," (", round(ranef.ci[,1], dec), ",", round(ranef.ci[,2], dec),")", sep="") |
|
91 | + | ranef.out <- cbind(ranef.paste, matrix(NA, nrow(ranef), 3)) |
|
92 | + | rownames(ranef.out) <- ranef[,1] |
|
96 | 93 | } |
|
97 | 94 | ||
98 | - | ranef.na = rbind(rep(NA, ncol(fix.all)), ranef.out) |
|
99 | - | rownames(ranef.na)[1] = "Random effects" |
|
100 | - | colnames(ranef.na) = colnames(fix.all) |
|
95 | + | ranef.na <- rbind(rep(NA, ncol(fix.all)), ranef.out) |
|
96 | + | rownames(ranef.na)[1] <- "Random effects" |
|
97 | + | colnames(ranef.na) <- colnames(fix.all) |
|
101 | 98 | ||
102 | 99 | ||
103 | 100 | ## rownames |
|
104 | - | fix.all.list = lapply(xf, function(x){fix.all[grepl(x, rownames(fix.all)),]}) |
|
105 | - | varnum.mfac = which(lapply(fix.all.list, length) > ncol(fix.all)) |
|
101 | + | fix.all.list <- lapply(xf, function(x){fix.all[grepl(x, rownames(fix.all)),]}) |
|
102 | + | varnum.mfac <- which(lapply(fix.all.list, length) > ncol(fix.all)) |
|
106 | 103 | lapply(varnum.mfac, function(x){fix.all.list[[x]] <<- rbind(rep(NA, ncol(fix.all)), fix.all.list[[x]])}) |
|
107 | - | fix.all.unlist = Reduce(rbind, fix.all.list) |
|
104 | + | fix.all.unlist <- Reduce(rbind, fix.all.list) |
|
108 | 105 | ||
109 | - | rn.list = lapply(xf, function(x){rownames(fix.all)[grepl(x, rownames(fix.all))]}) |
|
110 | - | varnum.2fac = which(lapply(xf, function(x){length(sapply(mdata, levels)[[x]])}) == 2) |
|
106 | + | rn.list <- lapply(xf, function(x){rownames(fix.all)[grepl(x, rownames(fix.all))]}) |
|
107 | + | varnum.2fac <- which(lapply(xf, function(x){length(sapply(mdata, levels)[[x]])}) == 2) |
|
111 | 108 | lapply(varnum.2fac, function(x){rn.list[[x]] <<- paste(xf[x], ": ", levels(mdata[, xf[x]])[2], " vs ", levels(mdata[, xf[x]])[1], sep="")}) |
|
112 | 109 | lapply(varnum.mfac, function(x){rn.list[[x]] <<- c(paste(xf[x],": ref.=", levels(mdata[, xf[x]])[1], sep=""), gsub(xf[x]," ", rn.list[[x]]))}) |
|
113 | 110 | if (class(fix.all.unlist)[1] == "character"){ |
|
114 | - | fix.all.unlist = t(data.frame(fix.all.unlist)) |
|
111 | + | fix.all.unlist <- t(data.frame(fix.all.unlist)) |
|
115 | 112 | } |
|
116 | - | rownames(fix.all.unlist) = unlist(rn.list) |
|
117 | - | tb.df = as.data.frame(rbind(fix.all.unlist, ranef.na)) |
|
113 | + | rownames(fix.all.unlist) <- unlist(rn.list) |
|
114 | + | tb.df <- as.data.frame(rbind(fix.all.unlist, ranef.na)) |
|
118 | 115 | ||
119 | 116 | ||
120 | 117 | ## metric |
|
121 | - | no.grp = sl$ngrps |
|
122 | - | no.obs = nrow(mdata) |
|
123 | - | ll = round(sl$logLik[[1]], dec) |
|
124 | - | aic = round(sl$AICtab, dec)[1] |
|
125 | - | met = c(NA, no.grp, no.obs, ll, aic) |
|
126 | - | met.mat = cbind(met, matrix(NA, length(met), ncol(fix.all) - 1 )) |
|
127 | - | rownames(met.mat) = c("Metrics", paste("No. of groups (", rownames(met.mat)[2:(length(no.grp) + 1)], ")", sep=""), "No. of observations", "Log-likelihood", "AIC value") |
|
128 | - | met.mat[, 1] = as.character(met.mat[, 1]) |
|
129 | - | colnames(met.mat) = colnames(tb.df) |
|
130 | - | tb.lmerMod = rbind(tb.df, met.mat) |
|
118 | + | no.grp <- sl$ngrps |
|
119 | + | no.obs <- nrow(mdata) |
|
120 | + | ll <- round(sl$logLik[[1]], dec) |
|
121 | + | aic <- round(sl$AICtab, dec)[1] |
|
122 | + | met <- c(NA, no.grp, no.obs, ll, aic) |
|
123 | + | met.mat <- cbind(met, matrix(NA, length(met), ncol(fix.all) - 1 )) |
|
124 | + | rownames(met.mat) <- c("Metrics", paste("No. of groups (", rownames(met.mat)[2:(length(no.grp) + 1)], ")", sep=""), "No. of observations", "Log-likelihood", "AIC value") |
|
125 | + | met.mat[, 1] <- as.character(met.mat[, 1]) |
|
126 | + | colnames(met.mat) <- colnames(tb.df) |
|
127 | + | tb.lmerMod <- rbind(tb.df, met.mat) |
|
131 | 128 | lapply(seq(2, ncol(fix.all), by =2), function(x){tb.lmerMod[, x] <<- as.numeric(as.vector(tb.lmerMod[, x]))}) |
|
132 | 129 | ||
133 | 130 | ## caption |
|
134 | - | cap.lmerMod = paste(sl$methTitle, " : ", y," ~ ", forms[3], sep="") |
|
131 | + | cap.lmerMod <- paste(sl$methTitle, " : ", y," ~ ", forms[3], sep="") |
|
135 | 132 | return(list(table = tb.lmerMod, caption = cap.lmerMod)) |
|
136 | 133 | } |
89 | 89 | if (!is.null(xc.vn)){ |
|
90 | 90 | names(mdata2)[ncol(mdata2)] <- xc.vn |
|
91 | 91 | } |
|
92 | - | basemodel <- update(model, formula(paste(c(". ~ .", xf), collapse=' - ')), data = mdata2) |
|
92 | + | basemodel <- update(model, stats::formula(paste(c(". ~ .", xf), collapse=' - ')), data = mdata2) |
|
93 | 93 | unis <- lapply(xf, function(x){ |
|
94 | - | newfit <- update(basemodel, formula(paste0(". ~ . +", x)), data= mdata2) |
|
94 | + | newfit <- update(basemodel, stats::formula(paste0(". ~ . +", x)), data= mdata2) |
|
95 | 95 | uni.res <- data.frame(summary(newfit)$coefficients) |
|
96 | 96 | uni.res <- uni.res[grep(x, rownames(uni.res)), ] |
|
97 | 97 | #uni.res <- uni.res[c(2:nrow(uni.res), 1), ] |
16 | 16 | #' @rdname svyglm.display |
|
17 | 17 | #' @export |
|
18 | 18 | #' @importFrom survey svyglm |
|
19 | + | #' @importFrom stats update |
|
19 | 20 | ||
20 | 21 | ||
21 | 22 | svyregress.display <- function(svyglm.obj, decimal = 2){ |
29 | 30 | if (length(xs) == 0){ |
|
30 | 31 | stop("No independent variable") |
|
31 | 32 | } else if (length(xs) ==1){ |
|
32 | - | uni <- data.frame(coefNA(survey::svyglm(as.formula(paste(y, " ~ ", xs)), design = design.model, family = model$family)))[-1, ] |
|
33 | + | uni <- data.frame(coefNA(model))[-1, ] |
|
33 | 34 | rn.uni <- lapply(list(uni), rownames) |
|
34 | 35 | #uni <- data.frame(summary(survey::svyglm(as.formula(paste(y, " ~ ", xs)), design = design.model, family = model$family))$coefficients)[-1, ] |
|
35 | 36 | if (gaussianT){ |
46 | 47 | ||
47 | 48 | } else{ |
|
48 | 49 | uni <- lapply(xs, function(v){ |
|
49 | - | data.frame(coefNA(survey::svyglm(as.formula(paste(y, " ~ ", v)), design = design.model, family = model$family)))[-1, ] |
|
50 | + | data.frame(coefNA(stats::update(model, formula(paste(paste(c(". ~ .", xs), collapse=' - '), " + ", v)), design = design.model)))[-1, ] |
|
50 | 51 | }) |
|
51 | 52 | #uni <- lapply(xs, function(v){ |
|
52 | 53 | # summary(survey::svyglm(as.formula(paste(y, " ~ ", v)), design = design.model))$coefficients[-1, ] |
30 | 30 | #' \code{\link[stats]{glm}} |
|
31 | 31 | #' @rdname glmshow.display |
|
32 | 32 | #' @export |
|
33 | - | #' @importFrom stats glm cor predict |
|
33 | + | #' @importFrom stats glm cor predict formula |
|
34 | 34 | ||
35 | 35 | glmshow.display <- function (glm.object, decimal = 2){ |
|
36 | 36 | model <- glm.object |
45 | 45 | if (length(xs) == 0){ |
|
46 | 46 | stop("No independent variable") |
|
47 | 47 | } else if (length(xs) ==1){ |
|
48 | - | uni <- data.frame(coefNA(stats::glm(as.formula(paste(y, " ~ ", xs)), data = data, family = model$family)))[-1, ] |
|
48 | + | uni <- data.frame(coefNA(glm.object))[-1, ] |
|
49 | 49 | rn.uni <- lapply(list(uni), rownames) |
|
50 | 50 | if (gaussianT){ |
|
51 | 51 | summ <- paste(round(uni[,1], decimal), " (", round(uni[, 1] - 1.96*uni[, 2], decimal), "," ,round(uni[, 1] + 1.96*uni[, 2], decimal), ")", sep ="") |
60 | 60 | res <- uni.res |
|
61 | 61 | ||
62 | 62 | } else{ |
|
63 | + | basemodel <- stats::update(model, formula(paste(c(". ~ .", xs), collapse=' - ')), data = data) |
|
64 | + | ||
63 | 65 | uni <- lapply(xs, function(v){ |
|
64 | - | data.frame(coefNA(stats::glm(as.formula(paste(y, " ~ ", v)), data = data, family = model$family)))[-1, ] |
|
66 | + | data.frame(coefNA(stats::update(basemodel, formula(paste0(". ~ . +", v)), data = data))) |
|
67 | + | #data.frame(coefNA(stats::glm(as.formula(paste(y, " ~ ", v)), data = data, family = model$family)))[-1, ] |
|
65 | 68 | }) |
|
66 | 69 | rn.uni <- lapply(uni, rownames) |
|
67 | 70 | uni <- Reduce(rbind, uni) |
Learn more Showing 1 files with coverage changes found.
R/gee.R
Files | Coverage |
---|---|
R | -0.36% 84.82% |
Project Totals (13 files) | 84.82% |
e9a4ac7
e1ee803