From 3cddf953c752fe34f441e4e81e8a5fe2b43f0072 Mon Sep 17 00:00:00 2001 From: sl-eeper Date: Fri, 10 Jan 2025 08:51:25 +0000 Subject: [PATCH 1/2] minor ui change --- R/forestcox.R | 61 +++++++++++++++++++++++++++++++++++++++++---------- R/forestglm.R | 46 +++++++++++++++++++++++++++++++++++++- 2 files changed, 94 insertions(+), 13 deletions(-) diff --git a/R/forestcox.R b/R/forestcox.R index cd07067..58e5db2 100644 --- a/R/forestcox.R +++ b/R/forestcox.R @@ -70,7 +70,10 @@ forestcoxUI <- function(id, label = "forestplot") { uiOutput(ns("cov_tbsub")), uiOutput(ns("time_tbsub")), checkboxInput(ns("cmp_risk_check"), "Competing Risk Analysis(Fine-Gray)"), - uiOutput(ns("cmp_eventtime")) + uiOutput(ns("cmp_eventtime")), + checkboxInput(ns("custom_forest"), "Custom X axis ticks in forest plot"), + uiOutput(ns("hr_points")), + uiOutput(ns("numeric_inputs")) ) } @@ -246,13 +249,35 @@ forestcoxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor # print(cluster_id) - output$xlim_forest <- renderUI({ - req(tbsub) - data <- tbsub() - data <- data[!(HR == 0 | Lower == 0)]$Upper - numericInput(session$ns("xMax"), "max HR for forestplot", value = round(max(as.numeric(data[data != "Inf"]), na.rm = TRUE), 2)) + + + observeEvent(input$custom_forest, { + output$hr_points <-renderUI({ + req(input$custom_forest == TRUE) + tagList( + sliderInput(session$ns("num_points"), "select number of x axis ticks", min = 2,max = 8,value = 3) + ) + }) + }) + + output$numeric_inputs <- renderUI({ + req(input$num_points) + fluidRow( + lapply(seq_len(input$num_points), function(i) { + column( + width = floor(12 / input$num_points), + numericInput( + session$ns(paste0("point_", i)), + paste("Point", i, ":"), + value = 1.0 + ) + ) + }) + ) }) + + observeEvent(input$cmp_risk_check, { output$cmp_eventtime <- renderUI({ req(input$cmp_risk_check == TRUE) @@ -410,6 +435,20 @@ forestcoxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor }) + + + ticks <- reactive({ + if (is.null(input$num_points)) { + a <- c(0, 1, 2) + } else { + a <- sapply(seq_len(input$num_points), function(i) input[[paste0("point_", i)]]) + } + return(a) + }) + + + + figure <- reactive({ group.tbsub <- input$group label <- data_label() @@ -430,8 +469,6 @@ forestcoxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor if (is.null(input$xMax) || any(is.na(xlim))) { xlim <- c(0, 2) } - - forestploter::forest(data[, .SD, .SDcols = selected_columns], lower = as.numeric(data$Lower), upper = as.numeric(data$Upper), @@ -440,8 +477,9 @@ forestcoxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor ref_line = 1, ticks_digits = 1, x_trans = "log", - xlim = xlim, + xlim = NULL, arrow_lab = c(input$arrow_left, input$arrow_right), + ticks_at = ticks(), theme = tm ) -> zz @@ -451,6 +489,7 @@ forestcoxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor zz$heights[(l[1] - 2):(l[1] - 1)] <- h return(zz) }) + res <- reactive({ list( datatable(tbsub(), @@ -463,13 +502,11 @@ forestcoxServer <- function(id, data, data_label, data_varStruct = NULL, nfactor figure() ) }) + output$downloadControls <- renderUI({ tagList( fluidRow( column( - 3, - uiOutput(session$ns("xlim_forest")) - ), column( 3, numericInput(session$ns("font"), "font-size", value = 12) ), diff --git a/R/forestglm.R b/R/forestglm.R index 56e363c..e12da80 100644 --- a/R/forestglm.R +++ b/R/forestglm.R @@ -59,6 +59,9 @@ forestglmUI <- function(id, label = "forestplot") { uiOutput(ns("dep_tbsub")), uiOutput(ns("subvar_tbsub")), uiOutput(ns("cov_tbsub")), + checkboxInput(ns("custom_forest"), "Custom X axis ticks in forest plot"), + uiOutput(ns("beta_points")), + uiOutput(ns("numeric_inputs")) ) } @@ -378,6 +381,46 @@ forestglmServer <- function(id, data, data_label, family, data_varStruct = NULL, return(tbsub) }) + + observeEvent(input$custom_forest, { + output$beta_points <-renderUI({ + req(input$custom_forest == TRUE) + tagList( + sliderInput(session$ns("num_points"), "select number of x axis ticks", min = 2,max = 8,value = 3) + ) + }) + }) + + output$numeric_inputs <- renderUI({ + req(input$num_points) + fluidRow( + lapply(seq_len(input$num_points), function(i) { + column( + width = floor(12 / input$num_points), + numericInput( + session$ns(paste0("point_", i)), + paste("Point", i, ":"), + value = 1.0 + ) + ) + }) + ) + }) + + + + ticks <- reactive({ + if (is.null(input$num_points)) { + a <- c(0, 1, 2) + } else { + a <- sapply(seq_len(input$num_points), function(i) input[[paste0("point_", i)]]) + } + return(a) + }) + + + + res <- reactive({ list( datatable(tbsub(), @@ -464,7 +507,8 @@ forestglmServer <- function(id, data, data_label, family, data_varStruct = NULL, ref_line = ifelse(family == "gaussian", 0, 1), x_trans = ifelse(family == "gaussian", "none", "log"), ticks_digits = 1, - xlim = xlim, + xlim = NULL, + ticks_at = ticks(), arrow_lab = c(input$arrow_left, input$arrow_right), theme = tm ) -> zz From afacec8844b52a7d35f50989ea9e70698cdc147e Mon Sep 17 00:00:00 2001 From: sl-eeper Date: Tue, 14 Jan 2025 07:54:12 +0000 Subject: [PATCH 2/2] add description and news --- DESCRIPTION | 2 +- NEWS.md | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index c7dd1a7..c2000f9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: jsmodule Title: 'RStudio' Addins and 'Shiny' Modules for Medical Research -Version: 1.6.1 +Version: 1.6.2 Date: 2025-01-08 Authors@R: c( person("Jinseob", "Kim", email = "jinseob2kim@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9403-605X")), diff --git a/NEWS.md b/NEWS.md index b7cc8e2..2f78167 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +# jsmodule 1.6.2 +## Update +- Add options to customize x axis ticks in forest plot + # jsmodule 1.6.1 ## Update - Add function to allow adjusting cutoff for a single independent variable and observing model's metrics in `rocModule`, `rocModule2`.