jinseob2kim / jstable

Compare e1ee803 ... +0 ... e9a4ac7

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

Learn more about Codecov Flags here.


@@ -16,11 +16,11 @@
Loading
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,7 +47,7 @@
Loading
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,17 +81,19 @@
Loading
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,19 +11,19 @@
Loading
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,87 +50,84 @@
Loading
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,9 +89,9 @@
Loading
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,6 +16,7 @@
Loading
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,7 +30,7 @@
Loading
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,7 +47,7 @@
Loading
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,7 +30,7 @@
Loading
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,7 +45,7 @@
Loading
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,8 +60,11 @@
Loading
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)

Click to load this diff.
Loading diff...

Learn more Showing 1 files with coverage changes found.

Changes in R/gee.R
-1
+1
Loading file...
Files Coverage
R -0.36% 84.82%
Project Totals (13 files) 84.82%
Loading