jinseob2kim / jstable
85.64% 92.68% +0.82%

s

Jinseob Kim jinseob2kim CI Passed

0644086 master e9a4ac7

Showing 2 of 4 files from the diff.
84.34% 92.31% +5.69%
R/forestglm.R changed.
83.67% 92.86% +4.95%
R/forestcox.R changed.
Other files ignored by Codecov
NEWS.md has changed.
DESCRIPTION has changed.

@@ -45,10 +45,8 @@
Loading
45 45 
  if (length(formula[[3]]) > 1) stop("Formula must contains only 1 independent variable")
46 46 
  if (any(class(data) == "survey.design" & !is.null(var_subgroup))){
47 47 
    if (is.numeric(data$variables[[var_subgroup]])) stop("var_subgroup must categorical.")
48 - 
    if (length(levels(data$variables[[as.character(formula[[3]])]])) != 2) stop("Independent variable must have 2 levels.")
49 48 
  } else if(any(class(data) == "data.frame" & !is.null(var_subgroup))){
50 49 
    if (is.numeric(data[[var_subgroup]])) stop("var_subgroup must categorical.")
51 - 
    if (length(levels(data[[as.character(formula[[3]])]])) != 2) stop("Independent variable must have 2 levels.")
52 50 
  }
53 51
54 52
@@ -74,18 +72,18 @@
Loading
74 72
75 73 
    if (any(class(data) == "survey.design")){
76 74 
      model <- survey::svyglm(formula, design = data, x= T, family = family.svyglm)
77 - 
      if (!is.null(model$xlevels) & length(model$xlevels[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
75 + 
      #if (!is.null(model$xlevels) & length(model$xlevels[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
78 76 
    } else{
79 - 
      model <- stats::glm(formula, data = data, x= TRUE, family = family)
80 - 
      if (!is.null(model$xlevels) & length(model$xlevels[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
77 + 
      model <- stats::glm(formula, data = data, x= T, family = family)
78 + 
      #if (!is.null(model$xlevels) & length(model$xlevels[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
81 79 
    }
82 80
83 81
84 - 
    Point.Estimate <- round(coef(model), decimal.estimate)[2]
85 - 
    CI <- round(confint(model)[2, ], decimal.estimate)
82 + 
    Point.Estimate <- round(stats::coef(model), decimal.estimate)[2]
83 + 
    CI <- round(stats::confint(model)[2, ], decimal.estimate)
86 84 
    if(family == "binomial"){
87 - 
      Point.Estimate <- round(exp(coef(model)), decimal.estimate)[2]
88 - 
      CI <- round(exp(confint(model)[2, ]), decimal.estimate)
85 + 
      Point.Estimate <- round(exp(stats::coef(model)), decimal.estimate)[2]
86 + 
      CI <- round(exp(stats::confint(model)[2, ]), decimal.estimate)
89 87 
    }
90 88
91 89
@@ -108,7 +106,7 @@
Loading
108 106 
    }
109 107
110 108 
    return(out)
111 - 
  } else if (length(var_subgroup) > 1 | any(grepl(var_subgroup, formula))){
109 + 
  } else if (length(var_subgroup) >= 2 | any(grepl(var_subgroup, formula))){
112 110 
    stop("Please input correct subgroup variable.")
113 111 
  } else{
114 112 
    if (!is.null(var_cov)){
@@ -118,30 +116,30 @@
Loading
118 116 
      data$variables[[var_subgroup]] %>% table %>% names -> label_val
119 117 
      label_val %>% purrr::map(~possible_svyglm(formula, design = subset(data, get(var_subgroup) == .), x = TRUE, family = family.svyglm)) -> model
120 118 
      xlev <- survey::svyglm(formula, design = data)$xlevels
121 - 
      xlabel <- names(attr(model[[which(!is.na(model))[1]]]$x, "contrast"))[1]
119 + 
      xlabel <- setdiff(as.character(formula)[[3]], "+")[1]
122 120 
      pvs_int <- possible_svyglm(as.formula(gsub(xlabel, paste(xlabel, "*", var_subgroup, sep=""), deparse(formula))), design = data, family = family.svyglm) %>% summary %>% coefficients
123 121 
      pv_int <- round(pvs_int[nrow(pvs_int), ncol(pvs_int)], decimal.pvalue)
124 - 
      if (!is.null(xlev) & length(xlev[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
122 + 
      #if (!is.null(xlev) & length(xlev[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
125 123
126 124
127 - 
      if (length(label_val) > 2){
125 + 
      if (length(label_val) > 2 | length(xlev) > 2){
128 126 
        model.int <- survey::svyglm(as.formula(gsub(xlabel, paste(xlabel, "*", var_subgroup, sep=""), deparse(formula))), design = data, family = family.svyglm)
129 127 
        pv_anova <- anova(model.int, method = "Wald")
130 - 
        pv_int <- pv_anova[[length(pv_anova)]][[7]]
128 + 
        pv_int <- round(pv_anova[[length(pv_anova)]][[7]], decimal.pvalue)
131 129 
      }
132 130 
      Count <- as.vector(table(data$variables[[var_subgroup]]))
133 131
134 132 
    } else{
135 - 
      data %>% filter(!is.na(get(var_subgroup))) %>% group_split(get(var_subgroup)) %>% purrr::map(~possible_glm(formula, data = ., x= T, family = family)) -> model
136 - 
      data %>% filter(!is.na(get(var_subgroup))) %>% select(var_subgroup) %>% table %>% names -> label_val
133 + 
      data %>% subset(!is.na(get(var_subgroup))) %>% group_split(get(var_subgroup)) %>% purrr::map(~possible_glm(formula, data = ., x= T, family = family)) -> model
134 + 
      data %>% subset(!is.na(get(var_subgroup))) %>% select(var_subgroup) %>% table %>% names -> label_val
137 135 
      xlev <- stats::glm(formula, data = data)$xlevels
138 - 
      xlabel <- names(attr(model[[which(!is.na(model))[1]]]$x, "contrast"))[1]
136 + 
      xlabel <- setdiff(as.character(formula)[[3]], "+")[1]
139 137 
      model.int <- possible_glm(as.formula(gsub(xlabel, paste(xlabel, "*", var_subgroup, sep=""), deparse(formula))), data = data, family = family)
140 138 
      pvs_int <- model.int %>% summary %>% coefficients
141 139 
      pv_int <- round(pvs_int[nrow(pvs_int), ncol(pvs_int)], decimal.pvalue)
142 - 
      if (!is.null(xlev) & length(xlev[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
140 + 
      #if (!is.null(xlev) & length(xlev[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
143 141
144 - 
      if (length(label_val) > 2){
142 + 
      if (length(label_val) > 2 | length(xlev) > 2){
145 143 
        pv_anova <- anova(model.int, test = "Chisq")
146 144 
        pv_int <- round(pv_anova[nrow(pv_anova), 5], decimal.pvalue)
147 145 
      }

@@ -48,10 +48,10 @@
Loading
48 48
49 49 
  if (any(class(data) == "survey.design" & !is.null(var_subgroup))){
50 50 
    if (is.numeric(data$variables[[var_subgroup]])) stop("var_subgroup must categorical.")
51 - 
    if (length(levels(data$variables[[as.character(formula[[3]])]])) != 2) stop("Independent variable must have 2 levels.")
51 + 
    #if (length(levels(data$variables[[as.character(formula[[3]])]])) != 2) stop("Independent variable must have 2 levels.")
52 52 
  } else if(any(class(data) == "data.frame" & !is.null(var_subgroup))){
53 53 
    if (is.numeric(data[[var_subgroup]])) stop("var_subgroup must categorical.")
54 - 
    if (length(levels(data[[as.character(formula[[3]])]])) != 2) stop("Independent variable must have 2 levels.")
54 + 
    #if (length(levels(data[[as.character(formula[[3]])]])) != 2) stop("Independent variable must have 2 levels.")
55 55 
  }
56 56
57 57
@@ -73,13 +73,13 @@
Loading
73 73 
    }
74 74 
    if (any(class(data) == "survey.design")){
75 75 
      model <- survey::svycoxph(formula, design = data, x= T)
76 - 
      if (!is.null(model$xlevels) & length(model$xlevels[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
76 + 
      #if (!is.null(model$xlevels) & length(model$xlevels[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
77 77 
      res.kap <- survey::svykm(formula.km, design = data)
78 78 
      prop <- round(100 * sapply(res.kap, function(x){1 - x[["surv"]][which.min(abs(x[["time"]] - time_eventrate))]}), decimal.percent)
79 79 
      names(prop) <- model$xlevels[[1]]
80 80 
    } else{
81 81 
      model <- survival::coxph(formula, data = data, x= TRUE)
82 - 
      if (!is.null(model$xlevels) & length(model$xlevels[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
82 + 
      #if (!is.null(model$xlevels) & length(model$xlevels[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
83 83 
      res.kap <- survival::survfit(formula.km, data = data)
84 84 
      res.kap.times <- summary(res.kap, times = time_eventrate, extend = T)
85 85 
      prop <- round(100 * (1 - res.kap.times[["surv"]]), decimal.percent)
@@ -100,9 +100,14 @@
Loading
100 100 
    #prop <- round(prop.table(table(event, model$x[, 1]), 2)[2, ] * 100, decimal.percent)
101 101 
    pv <- round(summary(model)$coefficients[1, "Pr(>|z|)"], decimal.pvalue)
102 102
103 - 
    tibble::tibble(Variable = "Overall", Count = model$n, Percent = 100, `Point Estimate` = Point.Estimate, Lower = CI[1], Upper = CI[2]) %>%
104 - 
      cbind(t(prop)) %>%
105 - 
      mutate(`P value` = ifelse(pv >= 0.001, pv, "<0.001"), `P for interaction` = NA) -> out
103 + 
    out <- data.frame(Variable = "Overall", Count = model$n, Percent = 100, `Point Estimate` = Point.Estimate, Lower = CI[1], Upper = CI[2], check.names = F) %>%
104 + 
      mutate(`P value` = ifelse(pv >= 0.001, pv, "<0.001"), `P for interaction` = NA)
105 +
106 + 
    if (!is.null(names(prop))){
107 + 
      out <- data.frame(Variable = "Overall", Count = model$n, Percent = 100, `Point Estimate` = Point.Estimate, Lower = CI[1], Upper = CI[2], check.names = F) %>%
108 + 
        cbind(t(prop)) %>%
109 + 
        mutate(`P value` = ifelse(pv >= 0.001, pv, "<0.001"), `P for interaction` = NA)
110 + 
    }
106 111
107 112 
    return(out)
108 113 
  } else if (length(var_subgroup) > 1 | any(grepl(var_subgroup, formula))){
@@ -115,44 +120,55 @@
Loading
115 120 
      data$variables[[var_subgroup]] %>% table %>% names -> label_val
116 121 
      label_val %>% purrr::map(~possible_svycoxph(formula, design = subset(data, get(var_subgroup) == .), x = TRUE)) -> model
117 122 
      xlev <- survey::svycoxph(formula, design = data)$xlevels
118 - 
      xlabel <- names(attr(model[[which(!is.na(model))[1]]]$x, "contrast"))[1]
123 + 
      xlabel <- setdiff(as.character(formula)[[3]], "+")[1]
119 124 
      pvs_int <- possible_svycoxph(as.formula(gsub(xlabel, paste0(xlabel, "*", var_subgroup), deparse(formula))), design = data) %>% summary %>% coefficients
120 125 
      pv_int <- round(pvs_int[nrow(pvs_int), ncol(pvs_int)], decimal.pvalue)
121 - 
      if (!is.null(xlev) & length(xlev[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
126 + 
      #if (!is.null(xlev) & length(xlev[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
122 127
123 128
124 - 
      if (length(label_val) > 2){
129 + 
      if (length(label_val) > 2 | length(xlev) > 2){
125 130 
        model.int <- survey::svycoxph(as.formula(gsub(xlabel, paste0(xlabel, "*", var_subgroup), deparse(formula))), design = data)
126 131 
        pv_anova <- survey::regTermTest(model.int, as.formula(paste0("~", xlabel, ":", var_subgroup)))
127 132 
        pv_int <- round(pv_anova$p[1], decimal.pvalue)
128 133 
      }
129 - 
      res.kap <- purrr::map(label_val, ~survey::svykm(formula.km, design = subset(data, get(var_subgroup) == . )))
130 - 
      mkz <- function(reskap){
131 - 
        round(100 * sapply(reskap, function(x){1 - x[["surv"]][which.min(abs(x[["time"]] - time_eventrate))]}), decimal.percent)
132 - 
      }
133 - 
      prop <- purrr::map(res.kap, mkz)  %>% dplyr::bind_cols() %>% t
134 - 
      #prop <- purrr::map(res.kap, ~round(100 * sapply(., function(x){1 - x[["surv"]][which.min(abs(x[["time"]] - time_eventrate))]}), decimal.percent))
135 - 
      colnames(prop) <- xlev[[1]]
134 +
135 + 
      if (!is.numeric(data$variables[[xlabel]])){
136 + 
        res.kap <- purrr::map(label_val, ~survey::svykm(formula.km, design = subset(data, get(var_subgroup) == . )))
137 + 
        mkz <- function(reskap){
138 + 
          round(100 * sapply(reskap, function(x){1 - x[["surv"]][which.min(abs(x[["time"]] - time_eventrate))]}), decimal.percent)
139 + 
        }
140 + 
        prop <- purrr::map(res.kap, mkz)  %>% dplyr::bind_cols() %>% t
141 + 
        #prop <- purrr::map(res.kap, ~round(100 * sapply(., function(x){1 - x[["surv"]][which.min(abs(x[["time"]] - time_eventrate))]}), decimal.percent))
142 + 
        colnames(prop) <- xlev[[1]]
143 + 
      } else{
144 + 
        prop <- NULL
145 + 
      }
146 +
136 147
137 148 
    } else{
138 149 
      data %>% filter(!is.na(get(var_subgroup))) %>% split(.[[var_subgroup]]) %>% purrr::map(~possible_coxph(formula, data = ., x= T)) -> model
139 150 
      data %>% filter(!is.na(get(var_subgroup))) %>% select(var_subgroup) %>% table %>% names -> label_val
140 151 
      xlev <- survival::coxph(formula, data = data)$xlevels
141 - 
      xlabel <- names(attr(model[[which(!is.na(model))[1]]]$x, "contrast"))[1]
152 + 
      xlabel <- setdiff(as.character(formula)[[3]], "+")[1]
142 153 
      model.int <- possible_coxph(as.formula(gsub(xlabel, paste0(xlabel, "*", var_subgroup), deparse(formula))), data = data)
143 154 
      pvs_int <- model.int %>% summary %>% coefficients
144 155 
      pv_int <- round(pvs_int[nrow(pvs_int), ncol(pvs_int)], decimal.pvalue)
145 - 
      if (!is.null(xlev) & length(xlev[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
156 + 
      #if (!is.null(xlev) & length(xlev[[1]]) != 2) stop("Categorical independent variable must have 2 levels.")
146 157
147 - 
      if (length(label_val) > 2){
158 + 
      if (length(label_val) > 2 | length(xlev) > 2){
148 159 
        model.int$call$formula <- as.formula(gsub(xlabel, paste0(xlabel, "*", var_subgroup), deparse(formula)))
149 160 
        model.int$call$data <- as.name("data")
150 161 
        pv_anova <- anova(model.int)
151 162 
        pv_int <- round(pv_anova[nrow(pv_anova), 4], decimal.pvalue)
152 163 
      }
153 - 
      res.kap.times <- data %>% filter(!is.na(get(var_subgroup))) %>% split(.[[var_subgroup]]) %>% purrr::map(~survival::survfit(formula.km, data = .)) %>% purrr::map(~summary(., times = time_eventrate, extend = T))
154 - 
      prop <- res.kap.times %>% purrr::map(~round(100 * (1 - .[["surv"]]), decimal.percent)) %>% dplyr::bind_cols() %>% t
155 - 
      colnames(prop) <- xlev[[1]]
164 +
165 + 
      if (!is.numeric(data[[xlabel]])){
166 + 
        res.kap.times <- data %>% filter(!is.na(get(var_subgroup))) %>% split(.[[var_subgroup]]) %>% purrr::map(~survival::survfit(formula.km, data = .)) %>% purrr::map(~summary(., times = time_eventrate, extend = T))
167 + 
        prop <- res.kap.times %>% purrr::map(~round(100 * (1 - .[["surv"]]), decimal.percent)) %>% dplyr::bind_cols() %>% t
168 + 
        colnames(prop) <- xlev[[1]]
169 + 
      } else{
170 + 
        prop <- NULL
171 + 
      }
156 172 
    }
157 173
158 174 
    model %>% purrr::map_dbl("n", .default = NA) -> Count
@@ -162,10 +178,15 @@
Loading
162 178 
    #purrr::map2(event, model, ~possible_table(.x, .y[["x"]][, 1])) %>% purrr::map(possible_prop.table) %>% purrr::map(~round(., decimal.percent)) %>% Reduce(rbind, .) -> prop
163 179 
    model %>% purrr::map(possible_pv) %>% purrr::map_dbl(~round(., decimal.pvalue)) -> pv
164 180
181 + 
    out <- data.frame(Variable = paste("  ", label_val) , Count = Count, Percent = round(Count/sum(Count) * 100, decimal.percent), `Point Estimate` = Point.Estimate, Lower = CI[, 1], Upper = CI[, 2], check.names = F) %>%
182 + 
      mutate(`P value` = ifelse(pv >= 0.001, pv, "<0.001"), `P for interaction` = NA)
183 +
184 + 
    if (!is.null(prop)){
185 + 
      out <- data.frame(Variable = paste("  ", label_val) , Count = Count, Percent = round(Count/sum(Count) * 100, decimal.percent), `Point Estimate` = Point.Estimate, Lower = CI[, 1], Upper = CI[, 2], check.names = F) %>%
186 + 
        cbind(prop) %>%
187 + 
        mutate(`P value` = ifelse(pv >= 0.001, pv, "<0.001"), `P for interaction` = NA)
188 + 
    }
165 189
166 - 
    tibble::tibble(Variable = paste("  ", label_val) , Count = Count, Percent = round(Count/sum(Count) * 100, decimal.percent), `Point Estimate` = Point.Estimate, Lower = CI[, 1], Upper = CI[, 2]) %>%
167 - 
      cbind(prop) %>%
168 - 
      mutate(`P value` = ifelse(pv >= 0.001, pv, "<0.001"), `P for interaction` = NA) -> out
169 190
170 191 
    return(rbind(c(var_subgroup, rep(NA, ncol(out) - 2), ifelse(pv_int >= 0.001, pv_int, "<0.001")), out))
171 192 
  }
Files Coverage
R 85.64%
Project Totals (13 files) 85.64%
Uploads Yaml
1428196119
View CI Build Download

No yaml found.

Create your codecov.yml to customize your Codecov experience

Read the docs
Interact now
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
SVG
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
SVG
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
SVG
Learn more about the coverage sunburst graph
Loading