From d10a722c483cb6b2e29fa6209adc832b16ebd5be Mon Sep 17 00:00:00 2001
From: hyojong myung <ecstatic2u@gmail.com>
Date: Thu, 26 Dec 2024 10:32:19 +0900
Subject: [PATCH] add subgroup analysis to propensity score
---
R/jsPropensityGadget.R | 106 +++++++++++++++++++++++++++++++++++++++++
1 file changed, 106 insertions(+)
diff --git a/R/jsPropensityGadget.R b/R/jsPropensityGadget.R
index 6ce07660..e4cd528b 100644
--- a/R/jsPropensityGadget.R
+++ b/R/jsPropensityGadget.R
@@ -1343,6 +1343,88 @@ jsPropensityExtAddin <- function(nfactor.limit = 20, max.filesize = 2048) {
)
)
)
+ ),
+ navbarMenu(
+ title = "Subgroup analysis",
+ icon = icon("chart-bar"),
+ tabPanel(
+ title = "subgroup cox",
+ sidebarLayout(
+ sidebarPanel(
+ forestcoxUI("Forest")
+ ),
+ mainPanel(
+ tabsetPanel(
+ type = "pills",
+ tabPanel(
+ title = "Data",
+ withLoader(
+ DTOutput("tablesub"),
+ type = "html",
+ loader = "loader6"
+ )
+ ),
+ tabPanel(
+ title = "figure",
+ plotOutput("forestplot", width = "100%"),
+ ggplotdownUI("Forest")
+ )
+ )
+ )
+ )
+ ),
+ tabPanel(
+ title = "subgroup regression",
+ sidebarLayout(
+ sidebarPanel(
+ forestglmUI("Forest_glm")
+ ),
+ mainPanel(
+ tabsetPanel(
+ type = "pills",
+ tabPanel(
+ title = "Data",
+ withLoader(
+ DTOutput("tablesub_glm"),
+ type = "html",
+ loader = "loader6"
+ )
+ ),
+ tabPanel(
+ title = "figure",
+ plotOutput("forestplot_glm", width = "100%"),
+ ggplotdownUI("Forest_glm")
+ )
+ )
+ )
+ )
+ ),
+ tabPanel(
+ title = "subgroup logistic regression",
+ sidebarLayout(
+ sidebarPanel(
+ forestglmUI("Forest_glmbi")
+ ),
+ mainPanel(
+ tabsetPanel(
+ type = "pills",
+ tabPanel(
+ title = "Data",
+ withLoader(
+ DTOutput("tablesub_glmbi"),
+ type = "html",
+ loader = "loader6"
+ )
+ ),
+ tabPanel(
+ title = "figure",
+ plotOutput("forestplot_glmbi", width = "100%"),
+ ggplotdownUI("Forest_glmbi")
+ )
+ )
+ )
+ )
+ )
)
)
@@ -2365,6 +2447,30 @@ jsPropensityExtAddin <- function(nfactor.limit = 20, max.filesize = 2048) {
)
})
+ outtable <- forestcoxServer("Forest", data = data, data_label = data.label)
+
+ output$tablesub <- renderDT({
+ outtable()[[1]]
+ })
+ output$forestplot <- renderPlot({
+ outtable()[[2]]
+ })
+ outtable_glm <- forestglmServer("Forest_glm", data = data, data_label = data.label, family = "gaussian")
+ output$tablesub_glm <- renderDT({
+ outtable_glm()[[1]]
+ })
+ output$forestplot_glm <- renderPlot({
+ outtable_glm()[[2]]
+ })
+ outtable_glmbi <- forestglmServer("Forest_glmbi", data = data, data_label = data.label, family = "binomial")
+ output$tablesub_glmbi <- renderDT({
+ outtable_glmbi()[[1]]
+ })
+ output$forestplot_glmbi <- renderPlot({
+ outtable_glmbi()[[2]]
+ })
+
+
session$onSessionEnded(function() {
stopApp()
})