Skip to content

Commit 55922df

Browse files
jinseob2kimjinseob2kim
authored
Merge pull request #42 from MyungHyojong/master
- Add subgroup analysis for propensity score matching/repeated/survey.
2 parents 51b72b3 + 35cc31e commit 55922df

File tree

5 files changed

+582
-316
lines changed

5 files changed

+582
-316
lines changed

‎NEWS.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
## Update
33
- Add function to allow adjusting cutoff for a single independent variable and observing model's metrics in `rocModule`, `rocModule2`.
44
- Add option to turn pairwise p value option on in case level of stratified group >= 3, in `tb1moduleUI`.
5+
- Add subgroup analysis for propensity score matching/repeated/survey.
56

67
# jsmodule 1.6.0
78
## Update

‎R/forestcox.R

Lines changed: 30 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
#' @description Shiny module UI for forestcox
33
#' @param id id
44
#' @param label label, Default: 'forestplot'
5+
#' @param cluster_id cluster id. default: NULL
56
#' @return Shinymodule UI
67
#' @details Shinymodule UI for forestcox
78
#' @examples
@@ -62,6 +63,7 @@
6263
forestcoxUI <- function(id, label = "forestplot") {
6364
ns <- NS(id)
6465
tagList(
66+
uiOutput(ns("cluster_id_ui")),
6567
uiOutput(ns("group_tbsub")),
6668
uiOutput(ns("dep_tbsub")),
6769
uiOutput(ns("day_tbsub")),
@@ -152,7 +154,7 @@ forestcoxUI <- function(id, label = "forestplot") {
152154
#' @importFrom rvg dml
153155
#' @importFrom officer read_pptx add_slide ph_with ph_location
154156

155-
forestcoxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit = 10, design.survey = NULL) {
157+
forestcoxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.limit = 10, design.survey = NULL, cluster_id = NULL) {
156158
moduleServer(
157159
id,
158160
function(input, output, session) {
@@ -242,6 +244,8 @@ forestcoxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor
242244
sliderInput(session$ns("time"), "Select time range", min = min(data()[[day]], na.rm = TRUE), max = max(data()[[day]], na.rm = TRUE), value = c(min(data()[[day]], na.rm = TRUE), max(data()[[day]], na.rm = TRUE)))
243245
})
244246

247+
print(cluster_id)
248+
245249
output$xlim_forest <- renderUI({
246250
req(tbsub)
247251
data <- tbsub()
@@ -309,10 +313,33 @@ forestcoxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor
309313
cox_data$cmpp_event <- factor(cox_data$cmpp_event)
310314
fg_data <- survival::finegray(formula = survival::Surv(cmpp_time, cmpp_event) ~ ., data = cox_data)
311315
tbsub <- TableSubgroupMultiCox(form, var_subgroups = vs, var_cov = setdiff(input$cov, vs), data = fg_data, time_eventrate = var.time[2], line = F, decimal.hr = 3, decimal.percent = 1, weights = "fgwt")
312-
} else {
316+
if(!is.null(cluster_id)){
317+
form <- as.formula(
318+
paste(
319+
"survival::Surv(fgstart, fgstop, fgstatus) ~ ",
320+
group.tbsub,
321+
" + cluster(", cluster_id, ")",
322+
sep = ""
323+
)
324+
)
325+
tbsub <- TableSubgroupMultiCox(form, var_subgroups = vs, var_cov = setdiff(input$cov, vs), data = fg_data, time_eventrate = var.time[2], line = F, decimal.hr = 3, decimal.percent = 1, weights = "fgwt")
326+
names(tbsub) <- gsub(paste0('\\s*\\+\\s*cluster\\(',cluster_id,'\\)'), '', names(tbsub))
327+
}
328+
329+
} else {
313330
form <- as.formula(paste("Surv(", var.day, ",", var.event, ") ~ ", group.tbsub, sep = ""))
331+
314332
tbsub <- TableSubgroupMultiCox(form, var_subgroups = vs, var_cov = setdiff(input$cov, vs), data = coxdata, time_eventrate = var.time[2], line = F, decimal.hr = 3, decimal.percent = 1)
315-
}
333+
if(!is.null(cluster_id)){
334+
form <- paste("Surv(", var.day, ",", var.event, ") ~ ", group.tbsub, sep = "")
335+
form <- as.formula(paste(form, " + cluster(", cluster_id, ")", sep = ""))
336+
print(form)
337+
tbsub <- TableSubgroupMultiCox(form, var_subgroups = vs, var_cov = setdiff(input$cov, vs), data = coxdata, time_eventrate = var.time[2], line = F, decimal.hr = 3, decimal.percent = 1)
338+
names(tbsub) <- gsub(paste0('\\s*\\+\\s*cluster\\(',cluster_id,'\\)'), '', names(tbsub))
339+
340+
}
341+
342+
}
316343

317344

318345

‎R/forestglm.R

Lines changed: 24 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -73,6 +73,7 @@ forestglmUI <- function(id, label = "forestplot") {
7373
#' @param data_varStruct Reactive List of variable structure, Default: NULL
7474
#' @param nfactor.limit nlevels limit in factor variable, Default: 10
7575
#' @param design.survey reactive survey data. default: NULL
76+
#' @param repeated_id data when repeated id. default: F
7677
#' @return Shiny module server for forestglm
7778
#' @details Shiny module server for forestglm
7879
#' @examples
@@ -137,7 +138,7 @@ forestglmUI <- function(id, label = "forestplot") {
137138
#' @importFrom rvg dml
138139
#' @importFrom officer read_pptx add_slide ph_with ph_location
139140

140-
forestglmServer <- function(id, data, data_label, family, data_varStruct = NULL, nfactor.limit = 10, design.survey = NULL) {
141+
forestglmServer <- function(id, data, data_label, family, data_varStruct = NULL, nfactor.limit = 10, design.survey = NULL, repeated_id = NULL) {
141142
moduleServer(
142143
id,
143144
function(input, output, session) {
@@ -211,6 +212,7 @@ forestglmServer <- function(id, data, data_label, family, data_varStruct = NULL,
211212
return(setdiff(names(data()), vlist()$isNA_vars))
212213
})
213214

215+
214216
output$group_tbsub <- renderUI({
215217
selectInput(session$ns("group"), "Group", choices = vlist()$group2_vars, selected = setdiff(vlist()$group2_vars, c(input$dep, dep()[1]))[1])
216218
})
@@ -269,6 +271,12 @@ forestglmServer <- function(id, data, data_label, family, data_varStruct = NULL,
269271
# data[[var.event]] <- ifelse(data[[var.day]] > 365 * 5 & data[[var.event]] == 1, 0, as.numeric(as.vector(data[[var.event]])))
270272

271273
tbsub <- jstable::TableSubgroupMultiGLM(form, var_subgroups = vs, var_cov = setdiff(input$cov, vs), data = coxdata, family = family)
274+
275+
if(!is.null(repeated_id)){
276+
form <- paste(var.event, " ~ ", group.tbsub, sep = "")
277+
form <- as.formula(paste0(form,'+ (1|', repeated_id, ')'))
278+
tbsub <- jstable::TableSubgroupMultiGLM(form, var_subgroups = vs, var_cov = setdiff(input$cov, vs), data = coxdata, family = family)
279+
}
272280
# tbsub <- TableSubgroupMultiGLM(form, var_subgroups = vs, data=coxdata,family=family)
273281
len <- nrow(label[variable == group.tbsub])
274282
data <- data.table::setDT(data)
@@ -373,11 +381,11 @@ forestglmServer <- function(id, data, data_label, family, data_varStruct = NULL,
373381
res <- reactive({
374382
list(
375383
datatable(tbsub(),
376-
caption = paste0(input$dep, " subgroup analysis"), rownames = F, extensions = "Buttons",
377-
options = c(
378-
opt.tb1(paste0("tbsub_", input$dep)),
379-
list(scrollX = TRUE, columnDefs = list(list(className = "dt-right", targets = 0)))
380-
)
384+
caption = paste0(input$dep, " subgroup analysis"), rownames = F, extensions = "Buttons",
385+
options = c(
386+
opt.tb1(paste0("tbsub_", input$dep)),
387+
list(scrollX = TRUE, columnDefs = list(list(className = "dt-right", targets = 0)))
388+
)
381389
),
382390
figure()
383391
)
@@ -449,16 +457,16 @@ forestglmServer <- function(id, data, data_label, family, data_varStruct = NULL,
449457
}
450458
selected_columns <- c(c(1:(2 + ll)), len + 1, (len - 1):(len))
451459
forestploter::forest(data[, .SD, .SDcols = selected_columns],
452-
lower = as.numeric(data$Lower),
453-
upper = as.numeric(data$Upper),
454-
ci_column = 3 + ll,
455-
est = as.numeric(data_est),
456-
ref_line = ifelse(family == "gaussian", 0, 1),
457-
x_trans = ifelse(family == "gaussian", "none", "log"),
458-
ticks_digits = 1,
459-
xlim = xlim,
460-
arrow_lab = c(input$arrow_left, input$arrow_right),
461-
theme = tm
460+
lower = as.numeric(data$Lower),
461+
upper = as.numeric(data$Upper),
462+
ci_column = 3 + ll,
463+
est = as.numeric(data_est),
464+
ref_line = ifelse(family == "gaussian", 0, 1),
465+
x_trans = ifelse(family == "gaussian", "none", "log"),
466+
ticks_digits = 1,
467+
xlim = xlim,
468+
arrow_lab = c(input$arrow_left, input$arrow_right),
469+
theme = tm
462470
) -> zz
463471

464472
l <- dim(zz)

‎R/jsRepeatedGadget.R

Lines changed: 120 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -728,6 +728,88 @@ jsRepeatedExtAddin <- function(nfactor.limit = 20, max.filesize = 2048) {
728728
)
729729
)
730730
)
731+
),
732+
navbarMenu(
733+
title = "Subgroup analysis",
734+
icon = icon("chart-bar"),
735+
tabPanel(
736+
title = "subgroup marginal cox",
737+
sidebarLayout(
738+
sidebarPanel(
739+
forestcoxUI("Forest")
740+
),
741+
mainPanel(
742+
tabsetPanel(
743+
type = "pills",
744+
tabPanel(
745+
title = "Data",
746+
withLoader(
747+
DTOutput("tablesub"),
748+
type = "html",
749+
loader = "loader6"
750+
)
751+
),
752+
tabPanel(
753+
title = "figure",
754+
plotOutput("forestplot", width = "100%"),
755+
ggplotdownUI("Forest")
756+
)
757+
)
758+
)
759+
)
760+
),
761+
tabPanel(
762+
title = "subgroup linear mixed model",
763+
sidebarLayout(
764+
sidebarPanel(
765+
forestglmUI("Forest_glm")
766+
),
767+
mainPanel(
768+
tabsetPanel(
769+
type = "pills",
770+
tabPanel(
771+
title = "Data",
772+
withLoader(
773+
DTOutput("tablesub_glm"),
774+
type = "html",
775+
loader = "loader6"
776+
)
777+
),
778+
tabPanel(
779+
title = "figure",
780+
plotOutput("forestplot_glm", width = "100%"),
781+
ggplotdownUI("Forest_glm")
782+
)
783+
)
784+
)
785+
)
786+
),
787+
tabPanel(
788+
title = "subgroup logistic GLMM",
789+
sidebarLayout(
790+
sidebarPanel(
791+
forestglmUI("Forest_glmbi")
792+
),
793+
mainPanel(
794+
tabsetPanel(
795+
type = "pills",
796+
tabPanel(
797+
title = "Data",
798+
withLoader(
799+
DTOutput("tablesub_glmbi"),
800+
type = "html",
801+
loader = "loader6"
802+
)
803+
),
804+
tabPanel(
805+
title = "figure",
806+
plotOutput("forestplot_glmbi", width = "100%"),
807+
ggplotdownUI("Forest_glmbi")
808+
)
809+
)
810+
)
811+
)
812+
)
731813
)
732814
)
733815

@@ -1090,9 +1172,45 @@ jsRepeatedExtAddin <- function(nfactor.limit = 20, max.filesize = 2048) {
10901172
)
10911173
})
10921174

1093-
session$onSessionEnded(function() {
1094-
stopApp()
1175+
1176+
observe({
1177+
outtable <- forestcoxServer(
1178+
id = "Forest",
1179+
data = data,
1180+
data_label = data.label,
1181+
cluster_id = id.gee() # Reactive 값 호출
1182+
)
1183+
1184+
output$tablesub <- renderDT({
1185+
outtable()[[1]]
1186+
})
1187+
1188+
output$forestplot <- renderPlot({
1189+
outtable()[[2]]
1190+
})
1191+
})
1192+
1193+
observe({
1194+
outtable_glm <- forestglmServer("Forest_glm", data = data, data_label = data.label, family = "gaussian", repeated_id = id.gee())
1195+
output$tablesub_glm <- renderDT({
1196+
outtable_glm()[[1]]
1197+
})
1198+
output$forestplot_glm <- renderPlot({
1199+
outtable_glm()[[2]]
1200+
})
10951201
})
1202+
1203+
observe({
1204+
outtable_glmbi <- forestglmServer("Forest_glmbi", data = data, data_label = data.label, family = "binomial", repeated_id = id.gee())
1205+
output$tablesub_glmbi <- renderDT({
1206+
outtable_glmbi()[[1]]
1207+
})
1208+
output$forestplot_glmbi <- renderPlot({
1209+
outtable_glmbi()[[2]]
1210+
})
1211+
})
1212+
1213+
10961214
}
10971215

10981216
# viewer <- dialogViewer("Descriptive statistics", width = 1100, height = 850)

0 commit comments

Comments
 (0)