From c97e4b50538e67f64174eba6406774c1a3358fed Mon Sep 17 00:00:00 2001 From: Tom Elliott Date: Thu, 2 Jan 2025 10:20:19 +1300 Subject: [PATCH] ui config for summary/inf (#397) * ui config for summary/inf * fix input limits; drop % round from inf --- DESCRIPTION | 1 + NEWS.md | 1 + panels/C1_Visualize/1_visualize-panel-ui.R | 27 ++++++- .../C1_Visualize/2_visualize-panel-server.R | 13 +++- panels/C1_Visualize/infoWindow.R | 78 ++++++++++++++++--- server.R | 17 +++- setup.R | 2 +- ui.R | 2 + 8 files changed, 119 insertions(+), 22 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 04aa2f13..b03d13d9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,6 +41,7 @@ Imports: shinydashboard, shinyjs, shinylogs, + shinyStorePlus, shinyWidgets, survey, surveyspec, diff --git a/NEWS.md b/NEWS.md index fe1232d9..8acd29b1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,7 @@ - **Time Series module** has been refactored to connect with our updated `iNZightTS` 2.0, which has new and improved graphics and funcionality. The old version remains available via _'Time Series - Legacy'_. - **Experimental design module** : help text added to improve usability. - **Bar plots** have a new option (under Add to Plot) to toggle whether or not the bars are sized by the group size (the historical default is for this to be on). +- **Summary** and **Inference** add options to control significant figures, percentage rounding, and p-value minimums. ## Bug fixes diff --git a/panels/C1_Visualize/1_visualize-panel-ui.R b/panels/C1_Visualize/1_visualize-panel-ui.R index e093dbe6..f2bc7e39 100644 --- a/panels/C1_Visualize/1_visualize-panel-ui.R +++ b/panels/C1_Visualize/1_visualize-panel-ui.R @@ -260,7 +260,26 @@ vis.mainPanel <- function() { column(10, hr()) ), helpText("Statistical Summary for the data."), - verbatimTextOutput("visualize.summary") + verbatimTextOutput("visualize.summary"), + helpText("Formatting options"), + fixedRow( + column( + 2, + numericInput("global.sig.level", + label = "Signifcant figures", + value = graphical.par$signif, + min = 1, step = 1 + ) + ), + column( + 2, + numericInput("global.round.pct", + label = "Round percentages", + value = graphical.par$round_percent, + min = 0, step = 1 + ) + ) + ) ), ## Inference Panel tabPanel( @@ -278,8 +297,8 @@ vis.mainPanel <- function() { fixedRow( column(3, uiOutput("inference_type")), column(3, uiOutput("inference_test")), - column(2, uiOutput("inference_out")), - column(3, uiOutput("ci_width")), + column(6, uiOutput("inference_out")), + column(9, uiOutput("inference_opts")), column(3, uiOutput("inference_epi")) ), br(), @@ -366,4 +385,4 @@ hidesidebar.visualize.panel.ui <- function(data.set) { ) } ) -} \ No newline at end of file +} diff --git a/panels/C1_Visualize/2_visualize-panel-server.R b/panels/C1_Visualize/2_visualize-panel-server.R index 6ecabcfd..b0603c65 100644 --- a/panels/C1_Visualize/2_visualize-panel-server.R +++ b/panels/C1_Visualize/2_visualize-panel-server.R @@ -441,7 +441,10 @@ graphical.par <- reactiveValues( cols[-k] <- iNZightPlots:::shade(cols[-k], 0.7) cols } - ) + ), + signif = 4, + round_percent = 2, + min_pval = 0.0001 ) ## Data handling @@ -7460,4 +7463,12 @@ observe({ }) +observeEvent(input$global.sig.level, { + graphical.par$signif <- input$global.sig.level +}) +observeEvent(input$global.round.pct, { + graphical.par$round_percent <- input$global.round.pct +}) + + source("panels/C1_Visualize/vit.R", local = T) diff --git a/panels/C1_Visualize/infoWindow.R b/panels/C1_Visualize/infoWindow.R index 95f53975..b3d29e8e 100644 --- a/panels/C1_Visualize/infoWindow.R +++ b/panels/C1_Visualize/infoWindow.R @@ -73,14 +73,31 @@ output$inference_test <- renderUI({ } # UI for "Additional Options: Confidence level (%):" - output$ci_width <- renderUI({ - numericInputIcon( - inputId = "ci.width", - label = div(h5(strong("Additional Options")), "Confidence level (%):"), - value = ci_width(), - min = 10, - max = 99, - # icon = list(NULL, "%") + output$inference_opts <- renderUI({ + fixedRow( + column( + 4, + numericInput( + inputId = "ci.width", + label = "Confidence level (%):", + value = ci_width(), + min = 10, + max = 99 + ) + ), + column( + 3, + numericInput("global.sig.level.inf", + label = "Signifcant figures", + value = graphical.par$signif, + min = 1, step = 1 + ) + ), + column(3, numericInput("global.p.val", + label = "Min P-value", + value = graphical.par$min_pval, + min = 0, max = 0.05, step = 0.0001 + )) ) }) @@ -357,6 +374,9 @@ output$visualize.inference <- renderPrint({ input$ci.width design_params$design input$inf_epi_out + graphical.par$signif + graphical.par$round_percent + graphical.par$min_pval isolate({ ## Design or data? is_survey <- !is.null(design_params$design$dataDesign) @@ -364,7 +384,7 @@ output$visualize.inference <- renderPrint({ reactiveValuesToList(graphical.par), keep.null = TRUE ) - curSet <- modifyList(reactiveValuesToList(plot.par), + curSet <- modifyList(curSet, reactiveValuesToList(inf.def.par), keep.null = TRUE ) @@ -603,13 +623,13 @@ output$visualize.inference <- renderPrint({ } .dataset <- get.data.set() - tryCatch({ - suppressWarnings(inf.print <- eval(construct_call(curSet, design_params$design, + inf_call <- construct_call(curSet, design_params$design, vartypes, data = quote(.dataset), what = "inference" - ))) + ) + suppressWarnings(inf.print <- eval(inf_call)) if (input$hypTest == "Chi-square test" && !is.null(input$hypTest)) { exp_match <- any(grepl("since some expected counts <", inf.print, fixed = TRUE)) @@ -706,3 +726,37 @@ output$visualize.summary <- renderPrint({ } } }) + +observeEvent(input$global.sig.level.inf, { + updateNumericInput(session, + inputId = "global.sig.level", + value = input$global.sig.level.inf + ) + graphical.par$signif <- input$global.sig.level.inf +}) +# other way around +observeEvent(input$global.sig.level, { + updateNumericInput(session, + inputId = "global.sig.level.inf", + value = input$global.sig.level + ) +}) + +# same for rounding +observeEvent(input$global.round.pct.inf, { + updateNumericInput(session, + inputId = "global.round.pct", + value = input$global.round.pct.inf + ) + graphical.par$round_percent <- input$global.round.pct.inf +}) +observeEvent(input$global.round.pct, { + updateNumericInput(session, + inputId = "global.round.pct.inf", + value = input$global.round.pct + ) +}) + +observeEvent(input$global.p.val, { + graphical.par$min_pval <- input$global.p.val +}) diff --git a/server.R b/server.R index 26872f5c..8ff2d0a2 100755 --- a/server.R +++ b/server.R @@ -610,11 +610,13 @@ shinyServer(function(input, output, session) { ) advance_tabs <- list( quick = tabPanel("Quick explore", uiOutput("quick.explore")), - time_series = tabPanel("Time Series", - # value = "timeSeries", - uiOutput("timeseries.panel") + time_series = tabPanel( + "Time Series", + # value = "timeSeries", + uiOutput("timeseries.panel") ), - time_series = tabPanel("Time Series (Legacy)", + time_series = tabPanel( + "Time Series (Legacy)", # value = "timeSeries", uiOutput("timeseries.legacy.panel") ), @@ -686,4 +688,11 @@ shinyServer(function(input, output, session) { } } }) + + # setupStorage( + # appId = "inzightlite", + # inputs = FALSE, + # dyn.inputs = "global.sig.level", + # session = session + # ) }) diff --git a/setup.R b/setup.R index 7d5f3ca9..b8984925 100644 --- a/setup.R +++ b/setup.R @@ -8,7 +8,7 @@ pak::repo_add("https://r.docker.stat.auckland.ac.nz") # pkgs <- read.delim(textConnection("colorspace countrycode DT# GGally ggmap plotly RcppTOML readr readtext readxl RgoogleMaps RJSONIO reshape2 sas7bdat shinyalert shinycssloaders shinydashboard shinyjs shinyWidgets srvyr styler survey viridis XML remotes vctrs pillar magrittr lifecycle crayon tibble rlang fansi cli ps rprojroot fs desc processx proxy wk e1071 units s2 Rcpp DBI classInt stringi generics cpp11 tidyselect stringr purrr dplyr sys openssl jsonlite curl sp png colorspace viridisLite RColorBrewer farver scales isoband gtable minqa Matrix MatrixModels SparseM timechange bit tzdb vroom hms blob zoo lubridate tidyr srvyr readr forcats dbplyr sass tinytex bslib xfun highr evaluate rmarkdown yaml digest rstudioapi htmltools htmlwidgets checkmate knitr matrixStats htmlTable data.table maditr mvtnorm estimability@1.4.1 httr rex waldo pkgload callr sf jpeg plyr ggplot2 s20x quantreg hexbin expss emmeans dichromat chron covr testthat rgeos lwgeom ggmap countrycode maptools XML settings validate markdown gridtext patchwork ggtext RcppEigen nloptr lme4 labelled sandwich TH.data pbkrtest abind carData broom.helpers multcomp ggrepel car Rttf2pt1 extrafontdb extrafont FNN productplots vipor beeswarm waffle hextri gridSVG ggthemes ggridges ggmosaic ggbeeswarm shinylogs wkb"), sep = " ", header = FALSE, comment.char = "#") |> as.character() -pkgs <- c("markdown", "GGally", "RJSONIO", "shinyjs", "plotly", "shinyWidgets", "DT", "shinycssloaders", "shinyalert", "rjson", "shinylogs", "bit64", "htmltools", "shiny", "sas7bdat") +pkgs <- c("markdown", "GGally", "RJSONIO", "shinyjs", "plotly", "shinyWidgets", "DT", "shinycssloaders", "shinyalert", "rjson", "shinylogs", "bit64", "htmltools", "shiny", "sas7bdat", "shinyStorePlus") pkgs <- c( diff --git a/ui.R b/ui.R index 30700b29..38bf2b44 100755 --- a/ui.R +++ b/ui.R @@ -18,11 +18,13 @@ cursor: not-allowed !important; border-color: #aaa !important; }" +# library(shinyStorePlus) shinyUI( fluidPage( shinyjs::useShinyjs(), shinyjs::inlineCSS(css), + # initStore("browser"), ## Set Tabpanel font to be size 16. tags$head( shinyjs::useShinyjs(),