jinseob2kim / jsmodule
Showing 1 of 6 files from the diff.
Other files ignored by Codecov
DESCRIPTION has changed.
NAMESPACE has changed.
NEWS.md has changed.

@@ -66,8 +66,7 @@
Loading
66 66
#' @param data data
67 67
#' @param design.survey survey data, Default: NULL
68 68
#' @param id.cluster cluster variable if marginal model, Default: NULL
69 -
#' @param iid logical. if calculationg confidence interval, Default: T
70 -
#' @return timeROC object
69 +
#' @return timeROC and coxph object
71 70
#' @details Helper function for timerocModule
72 71
#' @examples
73 72
#' #library(survival)
@@ -85,7 +84,7 @@
Loading
85 84
86 85
87 86
88 -
timeROChelper <- function(var.event, var.time, vars.ind, t, data, design.survey = NULL, id.cluster = NULL, iid = T) {
87 +
timeROChelper <- function(var.event, var.time, vars.ind, t, data, design.survey = NULL, id.cluster = NULL) {
89 88
  data[[var.event]] <- as.numeric(as.vector(data[[var.event]]))
90 89
  forms <- as.formula(paste0("survival::Surv(", var.time, ",", var.event, ") ~ " , paste(vars.ind, collapse = "+")))
91 90
@@ -100,6 +99,7 @@
Loading
100 99
  } else{
101 100
    cmodel <- survey::svycoxph(forms, design = design.survey, y = T)
102 101
  }
102 +
103 103
  lp <- stats::predict(cmodel, type = "lp")
104 104
  vec.y <- sapply(cmodel$y, `[[`, 1)
105 105
  out <- timeROC::timeROC(T = vec.y[1:(length(vec.y)/2)],
@@ -107,22 +107,35 @@
Loading
107 107
                          marker = lp,
108 108
                          cause = 1,
109 109
                          weighting="marginal",
110 -
                          times = t,
111 -
                          iid = iid)
110 +
                          times = t)
111 +
112 +
  ## Coxph object
113 +
  data[[var.event]][data[[var.event]] == 1 & data[[var.time]] > t] <- 0
114 +
  data[[var.time]][data[[var.time]] > t] <- t
115 +
  if (is.null(design.survey)){
116 +
    if (!is.null(id.cluster)){
117 +
      cmodel <- survival::coxph(forms, data = data, y = T, cluster = get(id.cluster))
118 +
    } else{
119 +
      cmodel <- survival::coxph(forms, data = data, y = T)
120 +
    }
112 121
113 -
  return(out)
122 +
  } else{
123 +
    cmodel <- survey::svycoxph(forms, design = design.survey, y = T)
124 +
  }
125 +
126 +
  return(list(coxph = cmodel, timeROC = out))
114 127
}
115 128
116 129
117 130
118 131
119 -
#' @title timeROC_table: extract AUC information from list of timeROC object.
120 -
#' @description extract AUC information from list of timeROC object.
121 -
#' @param ListModel list of timeROC object
132 +
#' @title timeROC_table: extract AUC information from list of timeROChelper object.
133 +
#' @description extract AUC information from list of timeROChelper object.
134 +
#' @param ListModel list of timeROChelper object
122 135
#' @param dec.auc digits for AUC, Default: 3
123 136
#' @param dec.p digits for p value, Default: 3
124 137
#' @return table of AUC information
125 -
#' @details extract AUC information from list of timeROC object.
138 +
#' @details extract AUC information from list of timeROChelper object.
126 139
#' @examples
127 140
#' #library(survival)
128 141
#' #list.timeROC <- lapply(list("age", c("age", "sex")),
@@ -134,31 +147,33 @@
Loading
134 147
#'  \code{\link[stats]{confint}}
135 148
#'  \code{\link[data.table]{data.table}}
136 149
#' @rdname timeROC_table
137 -
#' @importFrom stats confint
150 +
#' @importFrom stats confint qnorm
138 151
#' @importFrom data.table data.table
152 +
#' @importFrom survival concordance
139 153
140 154
timeROC_table <- function(ListModel, dec.auc =3, dec.p = 3){
141 -
  auc <- round(sapply(ListModel, function(x){x$AUC[[2]]}), dec.auc)
142 -
  if (all(sapply(ListModel, `[[`, "iid"))){
143 -
    auc.ci <- sapply(ListModel, function(x){ifelse(is.na(x$AUC[[2]]), NA, paste(round(stats::confint(x)$CI_AUC/100, dec.auc), collapse = "-"))})
144 -
145 -
    if (length(ListModel) == 1){
146 -
      out <- data.table::data.table(paste0("Model ", seq_along(ListModel)), auc, auc.ci)
147 -
      names(out) <- c("Prediction Model", "AUC", "95% CI")
148 -
    } else{
149 -
      auc.pdiff <- c(NA, sapply(seq_along(ListModel)[-1],
150 -
                                function(x){
151 -
                                  p <- timeROC::compare(ListModel[[x]], ListModel[[x-1]])$p_values_AUC[2]
152 -
                                  p <- ifelse(p < 0.001, "< 0.001", round(p, dec.p))
153 -
                                  return(p)
154 -
                                }))
155 -
156 -
      out <- data.table::data.table(paste0("Model ", seq_along(ListModel)), auc, auc.ci, auc.pdiff)
157 -
      names(out) <- c("Prediction Model", "AUC", "95% CI", "P-value for AUC Difference")
158 -
    }
155 +
  res.roc <- eval(parse(text = paste0("survival::concordance(", paste(paste0("lapply(ListModel, `[[`, 'coxph')[[", seq_along(ListModel), "]]"), collapse = ", "), ")")))
156 +
  auc <- res.roc$concordance
157 +
  se1.96 <- stats::qnorm(0.975) * sqrt(ifelse(length(ListModel) == 1, res.roc$var, diag(res.roc$var)))
158 +
  auc.ci <- paste0(round(auc - se1.96, dec.auc), "-", round(auc + se1.96, dec.auc))
159 +
  auc <- round(auc, dec.auc)
160 +
161 +
  if (length(ListModel) == 1){
162 +
    out <- data.table::data.table(paste0("Model ", seq_along(ListModel)), auc, auc.ci)
163 +
    names(out) <- c("Prediction Model", "AUC", "95% CI")
159 164
  } else{
160 -
    out <- data.table::data.table(paste0("Model ", seq_along(ListModel)), auc)
161 -
    names(out) <- c("Prediction Model", "AUC")
165 +
    auc.pdiff <- c(NA, sapply(seq_along(ListModel)[-1],
166 +
                              function(x){
167 +
                                contr <- c(-1, 1)
168 +
                                dtest <- contr %*% res.roc$concordance[(x-1):x]
169 +
                                dvar <- contr %*% res.roc$var[(x-1):x, (x-1):x] %*% contr
170 +
                                p <- 2 * pnorm(abs(dtest/sqrt(dvar)), lower.tail = F)
171 +
                                p <- ifelse(p < 0.001, "< 0.001", round(p, dec.p))
172 +
                                return(p)
173 +
                              }))
174 +
175 +
    out <- data.table::data.table(paste0("Model ", seq_along(ListModel)), auc, auc.ci, auc.pdiff)
176 +
    names(out) <- c("Prediction Model", "AUC", "95% CI", "P-value for AUC Difference")
162 177
  }
163 178
164 179
@@ -299,7 +314,7 @@
Loading
299 314
timerocModule <- function(input, output, session, data, data_label, data_varStruct = NULL, nfactor.limit = 10, design.survey = NULL, id.cluster = NULL, iid = T, NRIIDI = T) {
300 315
301 316
  ## To remove NOTE.
302 -
  compare <- level <- variable <- FP <- TP <- model <- NULL
317 +
  ListModel <- compare <- level <- variable <- FP <- TP <- model <- NULL
303 318
304 319
  if (is.null(data_varStruct)){
305 320
    data_varStruct <- reactive(list(variable = names(data())))
@@ -549,7 +564,7 @@
Loading
549 564
550 565
    if (is.null(design.survey)){
551 566
      if (is.null(id.cluster)){
552 -
        res.roc <- lapply(indeps(), function(x){timeROChelper(input$event_km, input$time_km, vars.ind =  x, t = input$time_to_roc, data = data.km, iid = iid)})
567 +
        res.roc <- lapply(indeps(), function(x){timeROChelper(input$event_km, input$time_km, vars.ind =  x, t = input$time_to_roc, data = data.km)})
553 568
554 569
        if ((nmodel() == 1 | NRIIDI == F)){
555 570
          res.tb <- timeROC_table(res.roc)
@@ -564,7 +579,7 @@
Loading
564 579
565 580
566 581
      } else{
567 -
        res.roc <- lapply(indeps(), function(x){timeROChelper(input$event_km, input$time_km, vars.ind =  x, t = input$time_to_roc, data = data.km, id.cluster = id.cluster(), iid = iid)})
582 +
        res.roc <- lapply(indeps(), function(x){timeROChelper(input$event_km, input$time_km, vars.ind =  x, t = input$time_to_roc, data = data.km, id.cluster = id.cluster())})
568 583
569 584
        if (nmodel() == 1 | NRIIDI == F){
570 585
          res.tb <- timeROC_table(res.roc)
@@ -612,7 +627,7 @@
Loading
612 627
613 628
      }
614 629
      res.roc <- lapply(indeps(), function(x){timeROChelper(input$event_km, input$time_km, vars.ind =  x,
615 -
                                                            t = input$time_to_roc, data = data.km, design.survey = data.design, iid = iid)})
630 +
                                                            t = input$time_to_roc, data = data.km, design.survey = data.design)})
616 631
617 632
      if (nmodel() == 1 | NRIIDI == F){
618 633
        res.tb <- timeROC_table(res.roc)
@@ -626,11 +641,12 @@
Loading
626 641
      }
627 642
    }
628 643
644 +
    res.timeROC <- lapply(res.roc, `[[`, "timeROC")
629 645
    data.rocplot <- data.table::rbindlist(
630 -
      lapply(1:length(res.roc),
646 +
      lapply(1:length(res.timeROC),
631 647
             function(x){
632 -
               data.table::data.table(FP = res.roc[[x]]$FP[, which(res.roc[[x]]$times == input$time_to_roc)],
633 -
                                      TP = res.roc[[x]]$TP[, which(res.roc[[x]]$times == input$time_to_roc)],
648 +
               data.table::data.table(FP = res.timeROC[[x]]$FP[, which(res.timeROC[[x]]$times == input$time_to_roc)],
649 +
                                      TP = res.timeROC[[x]]$TP[, which(res.timeROC[[x]]$times == input$time_to_roc)],
634 650
                                      model = paste0("model ", x))
635 651
               }))
636 652
@@ -772,7 +788,7 @@
Loading
772 788
timerocModule2 <- function(input, output, session, data, data_label, data_varStruct = NULL, nfactor.limit = 10, design.survey = NULL, id.cluster = NULL, iid = T, NRIIDI = T) {
773 789
774 790
  ## To remove NOTE.
775 -
  compare <- level <- variable <- FP <- TP <- model <- NULL
791 +
  ListModel <- compare <- level <- variable <- FP <- TP <- model <- NULL
776 792
777 793
  if (is.null(data_varStruct)){
778 794
    data_varStruct <- reactive(list(variable = names(data())))
@@ -1002,7 +1018,7 @@
Loading
1002 1018
1003 1019
    if (is.null(design.survey)){
1004 1020
      if (is.null(id.cluster)){
1005 -
        res.roc <- lapply(indeps(), function(x){timeROChelper(input$event_km, input$time_km, vars.ind =  x, t = input$time_to_roc, data = data.km, iid = iid)})
1021 +
        res.roc <- lapply(indeps(), function(x){timeROChelper(input$event_km, input$time_km, vars.ind =  x, t = input$time_to_roc, data = data.km)})
1006 1022
1007 1023
        if (nmodel() == 1 | NRIIDI == F){
1008 1024
          res.tb <- timeROC_table(res.roc)
@@ -1017,7 +1033,7 @@
Loading
1017 1033
1018 1034
1019 1035
      } else{
1020 -
        res.roc <- lapply(indeps(), function(x){timeROChelper(input$event_km, input$time_km, vars.ind =  x, t = input$time_to_roc, data = data.km, id.cluster = id.cluster(), iid = iid)})
1036 +
        res.roc <- lapply(indeps(), function(x){timeROChelper(input$event_km, input$time_km, vars.ind =  x, t = input$time_to_roc, data = data.km, id.cluster = id.cluster())})
1021 1037
1022 1038
        if (nmodel() == 1 | NRIIDI == F){
1023 1039
          res.tb <- timeROC_table(res.roc)
@@ -1065,7 +1081,7 @@
Loading
1065 1081
1066 1082
      }
1067 1083
      res.roc <- lapply(indeps(), function(x){timeROChelper(input$event_km, input$time_km, vars.ind =  x,
1068 -
                                                            t = input$time_to_roc, data = data.km, design.survey = data.design, iid = iid)})
1084 +
                                                            t = input$time_to_roc, data = data.km, design.survey = data.design)})
1069 1085
1070 1086
      if (nmodel() == 1 | NRIIDI == F){
1071 1087
        res.tb <- timeROC_table(res.roc)
@@ -1079,11 +1095,12 @@
Loading
1079 1095
      }
1080 1096
    }
1081 1097
1098 +
    res.timeROC <- lapply(res.roc, `[[`, "timeROC")
1082 1099
    data.rocplot <- data.table::rbindlist(
1083 -
      lapply(1:length(res.roc),
1100 +
      lapply(1:length(res.timeROC),
1084 1101
             function(x){
1085 -
               data.table::data.table(FP = res.roc[[x]]$FP[, which(res.roc[[x]]$times == input$time_to_roc)],
1086 -
                                      TP = res.roc[[x]]$TP[, which(res.roc[[x]]$times == input$time_to_roc)],
1102 +
               data.table::data.table(FP = res.timeROC[[x]]$FP[, which(res.timeROC[[x]]$times == input$time_to_roc)],
1103 +
                                      TP = res.timeROC[[x]]$TP[, which(res.timeROC[[x]]$times == input$time_to_roc)],
1087 1104
                                      model = paste0("model ", x))
1088 1105
             }))
1089 1106
Files Coverage
R 6.34%
Project Totals (19 files) 6.34%

No yaml found.

Create your codecov.yml to customize your Codecov experience

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.
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.
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.
Loading