ui config for summary/inf (#397)

* ui config for summary/inf

* fix input limits; drop % round from inf

DESCRIPTION

@@ -41,6 +41,7 @@ Imports:
     shinydashboard,
     shinyjs,
     shinylogs,
+    shinyStorePlus,
     shinyWidgets,
     survey,
     surveyspec,

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
 

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) {
       )
     }
   )
-}
+}

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)

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,14 +374,17 @@ 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)
       curSet <- modifyList(reactiveValuesToList(plot.par),
         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
+})

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
+  # )
 })

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 [email protected] 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(

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(),