diff --git a/.gitignore b/.gitignore index 8d43da94..3d1f2328 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ inst/doc .Rhistory .RData .DS_Store +..Rcheck diff --git a/DESCRIPTION b/DESCRIPTION index f617ce7e..dc8fe102 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: jsmodule Title: 'RStudio' Addins and 'Shiny' Modules for Medical Research -Version: 1.6.13 -Date: 2025-08-07 +Version: 1.6.14 +Date: 2025-09-08 Authors@R: c( person("Jinseob", "Kim", email = "jinseob2kim@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9403-605X")), person("Zarathu", role = c("cph", "fnd")), diff --git a/NAMESPACE b/NAMESPACE index 0b92447b..63269edc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -149,6 +149,8 @@ importFrom(rstudioapi,getActiveDocumentContext) importFrom(rvg,dml) importFrom(scales,label_pvalue) importFrom(see,theme_modern) +importFrom(shiny,need) +importFrom(shiny,validate) importFrom(shinyWidgets,dropdownButton) importFrom(shinyWidgets,tooltipOptions) importFrom(shinycustomloader,withLoader) diff --git a/NEWS.md b/NEWS.md index a78cf940..3b2e8616 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,7 @@ # jsmodule 1.6.14 ## Update - Added a checkbox to select the style of p-value: `exact number` or `stars`. +- Added a optionUI feature in scatter plot including color pallette feat. ## Bugfix - Fixed an error for the `boxplot`. diff --git a/R/jsBasicGadget.R b/R/jsBasicGadget.R index 4057dd2f..cab1c717 100644 --- a/R/jsBasicGadget.R +++ b/R/jsBasicGadget.R @@ -185,6 +185,7 @@ jsBasicGadget <- function(data, nfactor.limit = 20) { scatterUI("scatter") ), mainPanel( + optionUI("scatter"), withLoader(plotOutput("scatter_plot"), type = "html", loader = "loader6"), ggplotdownUI("scatter") ) @@ -1006,6 +1007,7 @@ jsBasicExtAddin <- function(nfactor.limit = 20, max.filesize = 2048) { scatterUI("scatter") ), mainPanel( + optionUI("scatter"), withLoader( plotOutput("scatter_plot"), type = "html", diff --git a/R/scatter.R b/R/scatter.R index b5a143f6..96861e9f 100644 --- a/R/scatter.R +++ b/R/scatter.R @@ -14,6 +14,7 @@ #' scatterUI("scatter") #' ), #' mainPanel( +#' optionUI("scatter"), #' plotOutput("scatter_plot"), #' ggplotdownUI("scatter") #' ) @@ -85,6 +86,7 @@ scatterUI <- function(id, label = "scatterplot") { #' scatterUI("scatter") #' ), #' mainPanel( +#' optionUI("scatter"), #' plotOutput("scatter_plot"), #' ggplotdownUI("scatter") #' ) @@ -267,13 +269,54 @@ scatterServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.l cor.coeff.args <- list(aes_string(color = input$strata), p.accuracy = 0.001) } - - - ggpubr::ggscatter(data, input$x_scatter, input$y_scatter, + # Apply option settings with default values if not available + point_size <- ifelse(is.null(input$point_size), 1.5, input$point_size) + point_alpha <- ifelse(is.null(input$point_alpha), 0.8, input$point_alpha) + line_size <- ifelse(is.null(input$line_size), 1, input$line_size) + ci_alpha <- ifelse(is.null(input$ci_alpha), 0.2, input$ci_alpha) + + # Update add.params for line settings + if (input$lineall == T) { + add.params <- list(color = "black", size = line_size) + } else if (add != "none") { + add.params <- list(size = line_size) + } + + # Apply palette settings + pal <- ifelse(is.null(input$pal_scatter), "Set1", input$pal_scatter) + + palette_arg <- NULL + if (input$strata != "None") { + n_group <- data[!is.na(get(input$strata)), uniqueN(get(input$strata))] + if (pal == "black") { + palette_arg <- rep("black", max(1, n_group)) + } else { + palette_arg <- pal + } + } else { + # strata가 None이어도 단일 색상 적용 가능 + if (pal == "black") { + palette_arg <- "black" + } else { + palette_arg <- pal + } + } + + # Create base plot + p <- ggpubr::ggscatter(data, input$x_scatter, input$y_scatter, color = color, add = add, add.params = add.params, conf.int = input$lineci, - cor.coef = cor.coef, cor.method = cor.method, cor.coeff.args = cor.coeff.args, xlab = label[variable == input$x_scatter, var_label][1], - ylab = label[variable == input$y_scatter, var_label][1], na.rm = T + cor.coef = cor.coef, cor.method = cor.method, cor.coeff.args = cor.coeff.args, + xlab = label[variable == input$x_scatter, var_label][1], + ylab = label[variable == input$y_scatter, var_label][1], na.rm = T, + size = point_size, alpha = point_alpha, palette = palette_arg ) + + # Adjust legend position if strata is used + if (input$strata != "None" && !is.null(input$legendx) && !is.null(input$legendy)) { + p <- p + ggplot2::theme(legend.position = c(input$legendx, input$legendy)) + } + + p }) output$downloadControls <- renderUI({ @@ -300,6 +343,62 @@ scatterServer <- function(id, data, data_label, data_varStruct = NULL, nfactor.l ) }) + output$option_kaplan <- renderUI({ + tagList( + h3("Point settings"), + sliderInput(session$ns("point_size"), "Point size", + min = 0.5, max = 5, value = 1.5, step = 0.1 + ), + sliderInput(session$ns("point_alpha"), "Point transparency", + min = 0.1, max = 1, value = 0.8, step = 0.1 + ), + conditionalPanel("input.line != 'None'", + ns = session$ns, + tagList( + h3("Regression line settings"), + sliderInput(session$ns("line_size"), "Line width", + min = 0.1, max = 3, value = 1, step = 0.1 + ), + sliderInput(session$ns("ci_alpha"), "Confidence interval transparency", + min = 0.1, max = 1, value = 0.2, step = 0.1 + ) + ) + ), + conditionalPanel("input.stat_cor != 'None'", + ns = session$ns, + tagList( + h3("Correlation display"), + sliderInput(session$ns("cor_x"), "Correlation x-position", + min = 0, max = 1, value = 0.05, step = 0.05 + ), + sliderInput(session$ns("cor_y"), "Correlation y-position", + min = 0, max = 1, value = 0.95, step = 0.05 + ), + sliderInput(session$ns("cor_size"), "Correlation font size", + min = 2, max = 8, value = 4, step = 0.5 + ) + ) + ), + h3("Point / Fill color"), + radioButtons(session$ns("pal_scatter"), "Palette", + choices = c("Set1", "black", "npg", "aaas", "nejm", "lancet", "jama", "jco", "frontiers"), + selected = "Set1", inline = T + ), + conditionalPanel("input.strata != 'None'", + ns = session$ns, + tagList( + h3("Legend position"), + sliderInput(session$ns("legendx"), "Legend x-position", + min = 0, max = 1, value = 0.85, step = 0.05 + ), + sliderInput(session$ns("legendy"), "Legend y-position", + min = 0, max = 1, value = 0.8, step = 0.05 + ) + ) + ) + ) + }) + output$downloadButton <- downloadHandler( filename = function() { paste(input$x_scatter, "_", input$y_scatter, "_scatterplot.", input$file_ext, sep = "") diff --git a/man/scatterServer.Rd b/man/scatterServer.Rd index 4c25aef0..3ddad0bb 100644 --- a/man/scatterServer.Rd +++ b/man/scatterServer.Rd @@ -36,6 +36,7 @@ ui <- fluidPage( scatterUI("scatter") ), mainPanel( + optionUI("scatter"), plotOutput("scatter_plot"), ggplotdownUI("scatter") ) diff --git a/man/scatterUI.Rd b/man/scatterUI.Rd index 5b2f9075..ed8eb1ee 100644 --- a/man/scatterUI.Rd +++ b/man/scatterUI.Rd @@ -30,6 +30,7 @@ ui <- fluidPage( scatterUI("scatter") ), mainPanel( + optionUI("scatter"), plotOutput("scatter_plot"), ggplotdownUI("scatter") )