From 80f7b6765217b85485de8a98e5c493a2e38ac2dc Mon Sep 17 00:00:00 2001 From: unknown Date: Mon, 29 Jan 2024 21:17:48 +0530 Subject: [PATCH 1/9] fixing the example app --- R/optionalInput.R | 170 ++++++++++----------- R/table_with_settings.R | 37 ++--- man/optionalSelectInput.Rd | 170 ++++++++++----------- man/table_with_settings.Rd | 41 ++--- vignettes/custom-basic-table-arguments.Rmd | 65 ++++---- vignettes/custom-ggplot2-arguments.Rmd | 65 ++++---- 6 files changed, 273 insertions(+), 275 deletions(-) diff --git a/R/optionalInput.R b/R/optionalInput.R index fb5c633e..4bf23474 100644 --- a/R/optionalInput.R +++ b/R/optionalInput.R @@ -52,101 +52,99 @@ #' ) #' } #' -#' -#' app <- shinyApp( -#' ui = ui_grid( -#' div( -#' optionalSelectInput( -#' inputId = "c1", -#' label = "Fixed choices", -#' choices = LETTERS[1:5], -#' selected = c("A", "B"), -#' fixed = TRUE -#' ), -#' verbatimTextOutput(outputId = "c1_out") +#' ui <- ui_grid( +#' div( +#' optionalSelectInput( +#' inputId = "c1", +#' label = "Fixed choices", +#' choices = LETTERS[1:5], +#' selected = c("A", "B"), +#' fixed = TRUE #' ), -#' div( -#' optionalSelectInput( -#' inputId = "c2", -#' label = "Single choice", -#' choices = "A", -#' selected = "A" -#' ), -#' verbatimTextOutput(outputId = "c2_out") +#' verbatimTextOutput(outputId = "c1_out") +#' ), +#' div( +#' optionalSelectInput( +#' inputId = "c2", +#' label = "Single choice", +#' choices = "A", +#' selected = "A" #' ), -#' div( -#' optionalSelectInput( -#' inputId = "c3", -#' label = "NULL choices", -#' choices = NULL -#' ), -#' verbatimTextOutput(outputId = "c3_out") +#' verbatimTextOutput(outputId = "c2_out") +#' ), +#' div( +#' optionalSelectInput( +#' inputId = "c3", +#' label = "NULL choices", +#' choices = NULL #' ), -#' div( -#' optionalSelectInput( -#' inputId = "c4", -#' label = "Default", -#' choices = LETTERS[1:5], -#' selected = "A" -#' ), -#' verbatimTextOutput(outputId = "c4_out") +#' verbatimTextOutput(outputId = "c3_out") +#' ), +#' div( +#' optionalSelectInput( +#' inputId = "c4", +#' label = "Default", +#' choices = LETTERS[1:5], +#' selected = "A" #' ), -#' div( -#' optionalSelectInput( -#' inputId = "c5", -#' label = "Named vector", -#' choices = c(`A - value A` = "A", `B - value B` = "B", `C - value C` = "C"), -#' selected = "A" -#' ), -#' verbatimTextOutput(outputId = "c5_out") +#' verbatimTextOutput(outputId = "c4_out") +#' ), +#' div( +#' optionalSelectInput( +#' inputId = "c5", +#' label = "Named vector", +#' choices = c(`A - value A` = "A", `B - value B` = "B", `C - value C` = "C"), +#' selected = "A" #' ), -#' div( -#' selectInput( -#' inputId = "c6_choices", label = "Update choices", choices = letters, multiple = TRUE -#' ), -#' optionalSelectInput( -#' inputId = "c6", -#' label = "Updated choices", -#' choices = NULL, -#' multiple = TRUE, -#' fixed_on_single = TRUE -#' ), -#' verbatimTextOutput(outputId = "c6_out") -#' ) +#' verbatimTextOutput(outputId = "c5_out") #' ), -#' server = function(input, output, session) { -#' observeEvent(input$c6_choices, ignoreNULL = FALSE, { -#' updateOptionalSelectInput( -#' session = session, -#' inputId = "c6", -#' choices = input$c6_choices, -#' selected = input$c6_choices -#' ) -#' }) -#' -#' output$c1_out <- renderPrint({ -#' input$c1 -#' }) -#' output$c2_out <- renderPrint({ -#' input$c2 -#' }) -#' output$c3_out <- renderPrint({ -#' input$c3 -#' }) -#' output$c4_out <- renderPrint({ -#' input$c4 -#' }) -#' output$c5_out <- renderPrint({ -#' input$c5 -#' }) -#' output$c6_out <- renderPrint({ -#' input$c6 -#' }) -#' } +#' div( +#' selectInput( +#' inputId = "c6_choices", label = "Update choices", choices = letters, multiple = TRUE +#' ), +#' optionalSelectInput( +#' inputId = "c6", +#' label = "Updated choices", +#' choices = NULL, +#' multiple = TRUE, +#' fixed_on_single = TRUE +#' ), +#' verbatimTextOutput(outputId = "c6_out") +#' ) #' ) #' +#' server <- function(input, output, session) { +#' observeEvent(input$c6_choices, ignoreNULL = FALSE, { +#' updateOptionalSelectInput( +#' session = session, +#' inputId = "c6", +#' choices = input$c6_choices, +#' selected = input$c6_choices +#' ) +#' }) +#' +#' output$c1_out <- renderPrint({ +#' input$c1 +#' }) +#' output$c2_out <- renderPrint({ +#' input$c2 +#' }) +#' output$c3_out <- renderPrint({ +#' input$c3 +#' }) +#' output$c4_out <- renderPrint({ +#' input$c4 +#' }) +#' output$c5_out <- renderPrint({ +#' input$c5 +#' }) +#' output$c6_out <- renderPrint({ +#' input$c6 +#' }) +#' } +#' #' if (interactive()) { -#' shinyApp(app$ui, app$server) +#' shinyApp(ui, server) #' } #' optionalSelectInput <- function(inputId, # nolint diff --git a/R/table_with_settings.R b/R/table_with_settings.R index d39291c0..e46cd876 100644 --- a/R/table_with_settings.R +++ b/R/table_with_settings.R @@ -51,28 +51,29 @@ table_with_settings_ui <- function(id, ...) { #' library(shiny) #' library(rtables) #' library(magrittr) -#' app <- shinyApp( -#' ui = fluidPage( -#' table_with_settings_ui( -#' id = "table_with_settings" -#' ) -#' ), -#' server = function(input, output, session) { -#' table_r <- reactive({ -#' l <- basic_table() %>% -#' split_cols_by("ARM") %>% -#' analyze(c("SEX", "AGE")) #' -#' tbl <- build_table(l, DM) +#' ui <- fluidPage( +#' table_with_settings_ui( +#' id = "table_with_settings" +#' ) +#' ) #' -#' tbl -#' }) +#' server <- function(input, output, session) { +#' table_r <- reactive({ +#' l <- basic_table() %>% +#' split_cols_by("ARM") %>% +#' analyze(c("SEX", "AGE")) +#' +#' tbl <- build_table(l, DM) +#' +#' tbl +#' }) +#' +#' table_with_settings_srv(id = "table_with_settings", table_r = table_r) +#' } #' -#' table_with_settings_srv(id = "table_with_settings", table_r = table_r) -#' } -#' ) #' if (interactive()) { -#' app +#' shinyApp(ui, server) #' } #' table_with_settings_srv <- function(id, table_r, show_hide_signal = reactive(TRUE)) { diff --git a/man/optionalSelectInput.Rd b/man/optionalSelectInput.Rd index 2466a20b..27049b43 100644 --- a/man/optionalSelectInput.Rd +++ b/man/optionalSelectInput.Rd @@ -96,101 +96,99 @@ ui_grid <- function(...) { ) } - -app <- shinyApp( - ui = ui_grid( - div( - optionalSelectInput( - inputId = "c1", - label = "Fixed choices", - choices = LETTERS[1:5], - selected = c("A", "B"), - fixed = TRUE - ), - verbatimTextOutput(outputId = "c1_out") +ui <- ui_grid( + div( + optionalSelectInput( + inputId = "c1", + label = "Fixed choices", + choices = LETTERS[1:5], + selected = c("A", "B"), + fixed = TRUE ), - div( - optionalSelectInput( - inputId = "c2", - label = "Single choice", - choices = "A", - selected = "A" - ), - verbatimTextOutput(outputId = "c2_out") + verbatimTextOutput(outputId = "c1_out") + ), + div( + optionalSelectInput( + inputId = "c2", + label = "Single choice", + choices = "A", + selected = "A" ), - div( - optionalSelectInput( - inputId = "c3", - label = "NULL choices", - choices = NULL - ), - verbatimTextOutput(outputId = "c3_out") + verbatimTextOutput(outputId = "c2_out") + ), + div( + optionalSelectInput( + inputId = "c3", + label = "NULL choices", + choices = NULL ), - div( - optionalSelectInput( - inputId = "c4", - label = "Default", - choices = LETTERS[1:5], - selected = "A" - ), - verbatimTextOutput(outputId = "c4_out") + verbatimTextOutput(outputId = "c3_out") + ), + div( + optionalSelectInput( + inputId = "c4", + label = "Default", + choices = LETTERS[1:5], + selected = "A" ), - div( - optionalSelectInput( - inputId = "c5", - label = "Named vector", - choices = c(`A - value A` = "A", `B - value B` = "B", `C - value C` = "C"), - selected = "A" - ), - verbatimTextOutput(outputId = "c5_out") + verbatimTextOutput(outputId = "c4_out") + ), + div( + optionalSelectInput( + inputId = "c5", + label = "Named vector", + choices = c(`A - value A` = "A", `B - value B` = "B", `C - value C` = "C"), + selected = "A" ), - div( - selectInput( - inputId = "c6_choices", label = "Update choices", choices = letters, multiple = TRUE - ), - optionalSelectInput( - inputId = "c6", - label = "Updated choices", - choices = NULL, - multiple = TRUE, - fixed_on_single = TRUE - ), - verbatimTextOutput(outputId = "c6_out") - ) + verbatimTextOutput(outputId = "c5_out") ), - server = function(input, output, session) { - observeEvent(input$c6_choices, ignoreNULL = FALSE, { - updateOptionalSelectInput( - session = session, - inputId = "c6", - choices = input$c6_choices, - selected = input$c6_choices - ) - }) - - output$c1_out <- renderPrint({ - input$c1 - }) - output$c2_out <- renderPrint({ - input$c2 - }) - output$c3_out <- renderPrint({ - input$c3 - }) - output$c4_out <- renderPrint({ - input$c4 - }) - output$c5_out <- renderPrint({ - input$c5 - }) - output$c6_out <- renderPrint({ - input$c6 - }) - } + div( + selectInput( + inputId = "c6_choices", label = "Update choices", choices = letters, multiple = TRUE + ), + optionalSelectInput( + inputId = "c6", + label = "Updated choices", + choices = NULL, + multiple = TRUE, + fixed_on_single = TRUE + ), + verbatimTextOutput(outputId = "c6_out") + ) ) +server <- function(input, output, session) { + observeEvent(input$c6_choices, ignoreNULL = FALSE, { + updateOptionalSelectInput( + session = session, + inputId = "c6", + choices = input$c6_choices, + selected = input$c6_choices + ) + }) + + output$c1_out <- renderPrint({ + input$c1 + }) + output$c2_out <- renderPrint({ + input$c2 + }) + output$c3_out <- renderPrint({ + input$c3 + }) + output$c4_out <- renderPrint({ + input$c4 + }) + output$c5_out <- renderPrint({ + input$c5 + }) + output$c6_out <- renderPrint({ + input$c6 + }) +} + if (interactive()) { - shinyApp(app$ui, app$server) + shinyApp(ui, server) } } diff --git a/man/table_with_settings.Rd b/man/table_with_settings.Rd index 73f70b3e..88ea4e15 100644 --- a/man/table_with_settings.Rd +++ b/man/table_with_settings.Rd @@ -33,28 +33,29 @@ A \code{shiny} module. library(shiny) library(rtables) library(magrittr) -app <- shinyApp( - ui = fluidPage( - table_with_settings_ui( - id = "table_with_settings" - ) - ), - server = function(input, output, session) { - table_r <- reactive({ - l <- basic_table() \%>\% - split_cols_by("ARM") \%>\% - analyze(c("SEX", "AGE")) - - tbl <- build_table(l, DM) - - tbl - }) - - table_with_settings_srv(id = "table_with_settings", table_r = table_r) - } + +ui <- fluidPage( + table_with_settings_ui( + id = "table_with_settings" + ) ) + +server <- function(input, output, session) { + table_r <- reactive({ + l <- basic_table() \%>\% + split_cols_by("ARM") \%>\% + analyze(c("SEX", "AGE")) + + tbl <- build_table(l, DM) + + tbl + }) + + table_with_settings_srv(id = "table_with_settings", table_r = table_r) +} + if (interactive()) { - app + shinyApp(ui, server) } } diff --git a/vignettes/custom-basic-table-arguments.Rmd b/vignettes/custom-basic-table-arguments.Rmd index 4b9ee06a..d7deb932 100644 --- a/vignettes/custom-basic-table-arguments.Rmd +++ b/vignettes/custom-basic-table-arguments.Rmd @@ -41,51 +41,52 @@ For multi-table case, per table (`basic_table_args_table`) and then default (`ba ## Example - Single-Table Module ```{r echo=TRUE} -options("teal.basic_table_args" = teal.widgets::basic_table_args(title = "ENV_TITLE")) library(shiny) library(teal.widgets) library(magrittr) +options("teal.basic_table_args" = basic_table_args(title = "ENV_TITLE")) + basic_table_args <- list( default = basic_table_args(prov_footer = "USER_FOOTER"), table1 = basic_table_args(subtitles = "USER_SUBTITLES_TABLE1"), table2 = basic_table_args(subtitles = "USER_SUBTITLES_TABLE2") ) -app <- shinyApp( - ui = fluidPage( - shinyjs::useShinyjs(), - div(verbatimTextOutput("table1")) - ), - server = function(input, output, session) { - dev_table_args <- teal.widgets::basic_table_args(show_colcounts = TRUE) - table_expr <- substitute( - expr = { - tt <- f_table_expr %>% - rtables::split_cols_by("Species") %>% - rtables::analyze(vars = "Sepal.Length", afun = function(x) { - rtables::in_rows( - "Mean" = rtables::rcell(mean(x), format = "xx.xx"), - "Range" = rtables::rcell(range(x), format = "xx.xx - xx.xx") - ) - }) - table2 <- rtables::build_table(tt, iris) - table2 - }, - env = list(f_table_expr = parse_basic_table_args( - teal.widgets::resolve_basic_table_args( - user_table = basic_table_args$table2, - user_default = basic_table_args$default, - module_table = dev_table_args - ) - )) - ) - output$table1 <- renderPrint(eval(table_expr)) - } +ui <- fluidPage( + shinyjs::useShinyjs(), + div(verbatimTextOutput("table1")) ) + +server <- function(input, output, session) { + dev_table_args <- basic_table_args(show_colcounts = TRUE) + + table_expr <- substitute( + expr = { + tt <- f_table_expr %>% + rtables::split_cols_by("Species") %>% + rtables::analyze(vars = "Sepal.Length", afun = function(x) { + rtables::in_rows( + "Mean" = rtables::rcell(mean(x), format = "xx.xx"), + "Range" = rtables::rcell(range(x), format = "xx.xx - xx.xx") + ) + }) + table2 <- rtables::build_table(tt, iris) + table2 + }, + env = list(f_table_expr = parse_basic_table_args( + resolve_basic_table_args( + user_table = basic_table_args$table2, + user_default = basic_table_args$default, + module_table = dev_table_args + ) + )) + ) + output$table1 <- renderPrint(eval(table_expr)) +} ``` ```{r echo=TRUE, eval = FALSE} -shinyApp(app$ui, app$server) +shinyApp(ui, server) ``` diff --git a/vignettes/custom-ggplot2-arguments.Rmd b/vignettes/custom-ggplot2-arguments.Rmd index b4f1626d..32b9cfbc 100644 --- a/vignettes/custom-ggplot2-arguments.Rmd +++ b/vignettes/custom-ggplot2-arguments.Rmd @@ -59,7 +59,7 @@ library(shiny) library(ggplot2) library(teal.widgets) -options("teal.ggplot2_args" = teal.widgets::ggplot2_args(labs = list(caption = "Caption from options"))) +options("teal.ggplot2_args" = ggplot2_args(labs = list(caption = "Caption from options"))) user_ggplot2_args <- list( default = ggplot2_args( @@ -72,41 +72,40 @@ user_ggplot2_args <- list( ) ) -app <- shinyApp( - ui = fluidPage( - shinyjs::useShinyjs(), - div(plotOutput("plot1")) - ), - server = function(input, output, session) { - dev_ggplot2_args <- ggplot2_args( - labs = list(subtitle = "Dev substitle"), - theme = list(legend.position = "none") - ) - - f_ggplot2_expr <- parse_ggplot2_args( - resolve_ggplot2_args( - user_plot = user_ggplot2_args$plot1, - user_default = user_ggplot2_args$default, - module_plot = dev_ggplot2_args - ) - ) +ui <- fluidPage( + shinyjs::useShinyjs(), + div(plotOutput("plot1")) +) - plot_expr <- substitute( - expr = { - gg <- ggplot(iris, aes(x = Sepal.Length, y = Petal.Length, color = Species)) + - geom_point() + - ggplot_expr_labs + - ggplot_expr_theme - print(gg) - }, - env = list(ggplot_expr_labs = f_ggplot2_expr$labs, ggplot_expr_theme = f_ggplot2_expr$theme) +server <- function(input, output, session) { + dev_ggplot2_args <- ggplot2_args( + labs = list(subtitle = "Dev substitle"), + theme = list(legend.position = "none") + ) + + f_ggplot2_expr <- parse_ggplot2_args( + resolve_ggplot2_args( + user_plot = user_ggplot2_args$plot1, + user_default = user_ggplot2_args$default, + module_plot = dev_ggplot2_args ) - print(plot_expr) - output$plot1 <- renderPlot(eval(plot_expr)) - } -) + ) + + plot_expr <- substitute( + expr = { + gg <- ggplot(iris, aes(x = Sepal.Length, y = Petal.Length, color = Species)) + + geom_point() + + ggplot_expr_labs + + ggplot_expr_theme + print(gg) + }, + env = list(ggplot_expr_labs = f_ggplot2_expr$labs, ggplot_expr_theme = f_ggplot2_expr$theme) + ) + print(plot_expr) + output$plot1 <- renderPlot(eval(plot_expr)) +} ``` ```{r echo=TRUE, eval = FALSE} -shinyApp(app$ui, app$server) +shinyApp(ui, server) ``` From 8a03ec38432b2b2bbbe67d732cf0295f123bdda4 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Mon, 29 Jan 2024 15:51:09 +0000 Subject: [PATCH 2/9] [skip actions] Restyle files --- vignettes/custom-basic-table-arguments.Rmd | 2 +- vignettes/custom-ggplot2-arguments.Rmd | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/vignettes/custom-basic-table-arguments.Rmd b/vignettes/custom-basic-table-arguments.Rmd index d7deb932..8dac63b1 100644 --- a/vignettes/custom-basic-table-arguments.Rmd +++ b/vignettes/custom-basic-table-arguments.Rmd @@ -61,7 +61,7 @@ ui <- fluidPage( server <- function(input, output, session) { dev_table_args <- basic_table_args(show_colcounts = TRUE) - + table_expr <- substitute( expr = { tt <- f_table_expr %>% diff --git a/vignettes/custom-ggplot2-arguments.Rmd b/vignettes/custom-ggplot2-arguments.Rmd index 32b9cfbc..5c9dd6f6 100644 --- a/vignettes/custom-ggplot2-arguments.Rmd +++ b/vignettes/custom-ggplot2-arguments.Rmd @@ -82,7 +82,7 @@ server <- function(input, output, session) { labs = list(subtitle = "Dev substitle"), theme = list(legend.position = "none") ) - + f_ggplot2_expr <- parse_ggplot2_args( resolve_ggplot2_args( user_plot = user_ggplot2_args$plot1, @@ -90,7 +90,7 @@ server <- function(input, output, session) { module_plot = dev_ggplot2_args ) ) - + plot_expr <- substitute( expr = { gg <- ggplot(iris, aes(x = Sepal.Length, y = Petal.Length, color = Species)) + From 4d94d7a8d95a0d73235c56316df94b50be7aaf1e Mon Sep 17 00:00:00 2001 From: kartikeyakirar Date: Mon, 29 Jan 2024 22:19:35 +0530 Subject: [PATCH 3/9] 'trigger' From 1b94207155b5fe3e91bc582b4b5a677df94deae2 Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Mon, 29 Jan 2024 16:52:10 +0000 Subject: [PATCH 4/9] [skip actions] Roxygen Man Pages Auto Update --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3ff4f837..51dd0bee 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -58,4 +58,4 @@ Encoding: UTF-8 Language: en-US LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.0 +RoxygenNote: 7.3.1 From b5efc8f279654dde98b5eb84636e0d1f4128e349 Mon Sep 17 00:00:00 2001 From: kartikeya kirar Date: Tue, 30 Jan 2024 17:54:11 +0530 Subject: [PATCH 5/9] Update R/optionalInput.R MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Signed-off-by: kartikeya kirar --- R/optionalInput.R | 24 ++++++------------------ 1 file changed, 6 insertions(+), 18 deletions(-) diff --git a/R/optionalInput.R b/R/optionalInput.R index 4bf23474..c9305ff5 100644 --- a/R/optionalInput.R +++ b/R/optionalInput.R @@ -123,24 +123,12 @@ #' ) #' }) #' -#' output$c1_out <- renderPrint({ -#' input$c1 -#' }) -#' output$c2_out <- renderPrint({ -#' input$c2 -#' }) -#' output$c3_out <- renderPrint({ -#' input$c3 -#' }) -#' output$c4_out <- renderPrint({ -#' input$c4 -#' }) -#' output$c5_out <- renderPrint({ -#' input$c5 -#' }) -#' output$c6_out <- renderPrint({ -#' input$c6 -#' }) +#' output$c1_out <- renderPrint(input$c1) +#' output$c2_out <- renderPrint(input$c2) +#' output$c3_out <- renderPrint(input$c3) +#' output$c4_out <- renderPrint(input$c4) +#' output$c5_out <- renderPrint(input$c5) +#' output$c6_out <- renderPrint(input$c6) #' } #' #' if (interactive()) { From dee4208fa326e07010bedaa2dfa221cae726ee69 Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Tue, 30 Jan 2024 12:26:32 +0000 Subject: [PATCH 6/9] [skip actions] Roxygen Man Pages Auto Update --- man/optionalSelectInput.Rd | 24 ++++++------------------ 1 file changed, 6 insertions(+), 18 deletions(-) diff --git a/man/optionalSelectInput.Rd b/man/optionalSelectInput.Rd index 27049b43..a9939a75 100644 --- a/man/optionalSelectInput.Rd +++ b/man/optionalSelectInput.Rd @@ -167,24 +167,12 @@ server <- function(input, output, session) { ) }) - output$c1_out <- renderPrint({ - input$c1 - }) - output$c2_out <- renderPrint({ - input$c2 - }) - output$c3_out <- renderPrint({ - input$c3 - }) - output$c4_out <- renderPrint({ - input$c4 - }) - output$c5_out <- renderPrint({ - input$c5 - }) - output$c6_out <- renderPrint({ - input$c6 - }) + output$c1_out <- renderPrint(input$c1) + output$c2_out <- renderPrint(input$c2) + output$c3_out <- renderPrint(input$c3) + output$c4_out <- renderPrint(input$c4) + output$c5_out <- renderPrint(input$c5) + output$c6_out <- renderPrint(input$c6) } if (interactive()) { From 798aa375d01bc16fae7734dd714a224ddc237dda Mon Sep 17 00:00:00 2001 From: unknown Date: Tue, 30 Jan 2024 18:42:32 +0530 Subject: [PATCH 7/9] suggestions --- R/draggable_buckets.R | 28 ++--- R/get_dt_rows.R | 6 +- R/nested_closeable_modal.R | 14 ++- R/plot_with_settings.R | 225 +++++++++++++++++---------------- R/verbatim_popup.R | 5 +- man/draggable_buckets.Rd | 28 ++--- man/get_dt_rows.Rd | 6 +- man/nested_closeable_modal.Rd | 14 ++- man/plot_with_settings.Rd | 226 +++++++++++++++++----------------- man/verbatim_popup.Rd | 5 +- 10 files changed, 282 insertions(+), 275 deletions(-) diff --git a/R/draggable_buckets.R b/R/draggable_buckets.R index 8c2633ff..fc92fca6 100644 --- a/R/draggable_buckets.R +++ b/R/draggable_buckets.R @@ -14,12 +14,12 @@ #' @details `shinyvalidate` validation can be used with this widget. See example below. #' #' @examples -#' -#' ui <- shiny::fluidPage( +#' library(shiny) +#' ui <- fluidPage( #' draggable_buckets("id", "Choices #1", c("a", "b"), c("bucket1", "bucket2")), #' draggable_buckets("id2", "Choices #2", letters, c("vowels", "consonants")), -#' shiny::verbatimTextOutput("out"), -#' shiny::verbatimTextOutput("out2") +#' verbatimTextOutput("out"), +#' verbatimTextOutput("out2") #' ) #' server <- function(input, output) { #' iv <- shinyvalidate::InputValidator$new() @@ -29,30 +29,30 @@ #' ) #' iv$enable() #' -#' shiny::observeEvent(list(input$id, input$id2), { +#' observeEvent(list(input$id, input$id2), { #' print(isolate(input$id)) #' print(isolate(input$id2)) #' }) -#' output$out <- shiny::renderPrint({ +#' output$out <- renderPrint({ #' iv$is_valid() #' input$id #' }) -#' output$out2 <- shiny::renderPrint(input$id2) +#' output$out2 <- renderPrint(input$id2) #' } -#' if (interactive()) shiny::shinyApp(ui, server) +#' if (interactive()) shinyApp(ui, server) #' #' # With default elements in the bucket -#' ui <- shiny::fluidPage( +#' ui <- fluidPage( #' draggable_buckets("id", "Choices #1", c("a", "b"), list(bucket1 = character(), bucket2 = c("c"))), -#' shiny::verbatimTextOutput("out") +#' verbatimTextOutput("out") #' ) #' server <- function(input, output) { -#' shiny::observeEvent(input$id, { -#' print(shiny::isolate(input$id)) +#' observeEvent(input$id, { +#' print(isolate(input$id)) #' }) -#' output$out <- shiny::renderPrint(input$id) +#' output$out <- renderPrint(input$id) #' } -#' if (interactive()) shiny::shinyApp(ui, server) +#' if (interactive()) shinyApp(ui, server) draggable_buckets <- function(input_id, label, elements = character(), buckets) { checkmate::assert_string(input_id) checkmate::assert_true(inherits(label, "character") || inherits(label, "shiny.tag")) diff --git a/R/get_dt_rows.R b/R/get_dt_rows.R index b8117b17..906a460a 100644 --- a/R/get_dt_rows.R +++ b/R/get_dt_rows.R @@ -10,10 +10,12 @@ #' #' @examples #' library(shiny) +#' library(DT) +#' #' ui <- function(id) { #' ns <- NS(id) #' tagList( -#' DT::DTOutput(ns("data_table")), +#' DTOutput(ns("data_table")), #' get_dt_rows(ns("data_table"), ns("dt_rows")) #' ) #' } @@ -21,7 +23,7 @@ #' # use the input$dt_rows in the Shiny Server function #' server <- function(id) { #' moduleServer(id, function(input, output, session) { -#' output$data_table <- DT::renderDataTable( +#' output$data_table <- renderDataTable( #' { #' iris #' }, diff --git a/R/nested_closeable_modal.R b/R/nested_closeable_modal.R index 00e594cb..7a77d530 100644 --- a/R/nested_closeable_modal.R +++ b/R/nested_closeable_modal.R @@ -17,8 +17,10 @@ #' @examples #' # nolint start #' library(shiny) +#' library(shinyjs) +#' #' ui <- fluidPage( -#' shinyjs::useShinyjs(), +#' useShinyjs(), #' actionButton("show_1", "$('#modal_1').modal('show')"), #' nested_closeable_modal( #' "modal_1", @@ -61,20 +63,20 @@ #' ) #' server <- function(input, output) { #' observeEvent(input$show_1, { -#' shinyjs::runjs("$('#modal_1').modal('show')") +#' runjs("$('#modal_1').modal('show')") #' }) #' observeEvent(input$show_2, { -#' shinyjs::runjs("$('#modal_2').modal('show')") +#' runjs("$('#modal_2').modal('show')") #' }) #' observeEvent(c(input$hide_1, input$hide_all), { -#' shinyjs::runjs("$('#modal_1').modal('hide')") +#' runjs("$('#modal_1').modal('hide')") #' }) #' observeEvent(input$hide_2, { -#' shinyjs::runjs("$('#modal_2').modal('hide')") +#' runjs("$('#modal_2').modal('hide')") #' }) #' } #' if (interactive()) { -#' shiny::shinyApp(ui, server) +#' shinyApp(ui, server) #' } #' # nolint end nested_closeable_modal <- function(id, ..., modal_args = list(easyClose = TRUE)) { diff --git a/R/plot_with_settings.R b/R/plot_with_settings.R index 6f61aec2..65311ca8 100644 --- a/R/plot_with_settings.R +++ b/R/plot_with_settings.R @@ -111,145 +111,144 @@ plot_with_settings_ui <- function(id) { #' @examples #' # Example using a reactive as input to plot_r #' library(shiny) -#' app1 <- shinyApp( -#' ui = fluidPage( -#' plot_with_settings_ui( -#' id = "plot_with_settings" -#' ) -#' ), -#' server = function(input, output, session) { -#' plot_r <- reactive({ -#' ggplot2::ggplot(faithful, ggplot2::aes(x = waiting, y = eruptions)) + -#' ggplot2::geom_point() -#' }) -#' -#' plot_with_settings_srv( -#' id = "plot_with_settings", -#' plot_r = plot_r, -#' height = c(400, 100, 1200), -#' width = c(500, 250, 750) -#' ) -#' } +#' library(ggplot2) +#' +#' ui <- fluidPage( +#' plot_with_settings_ui( +#' id = "plot_with_settings" +#' ) #' ) #' +#' server <- function(input, output, session) { +#' plot_r <- reactive({ +#' ggplot(faithful, aes(x = waiting, y = eruptions)) + +#' geom_point() +#' }) +#' +#' plot_with_settings_srv( +#' id = "plot_with_settings", +#' plot_r = plot_r, +#' height = c(400, 100, 1200), +#' width = c(500, 250, 750) +#' ) +#' } +#' #' if (interactive()) { -#' shinyApp(app1$ui, app1$server) +#' shinyApp(ui, server) #' } #' #' # Example using a function as input to plot_r -#' app2 <- shinyApp( -#' ui = fluidPage( -#' radioButtons("download_option", "Select the Option", list("ggplot", "trellis", "grob", "base")), -#' plot_with_settings_ui( -#' id = "plot_with_settings" -#' ), -#' sliderInput("nums", "Value", 1, 10, 1) +#' library(lattice) +#' ui <- fluidPage( +#' radioButtons("download_option", "Select the Option", list("ggplot", "trellis", "grob", "base")), +#' plot_with_settings_ui( +#' id = "plot_with_settings" #' ), -#' server = function(input, output, session) { -#' plot_r <- function() { -#' numbers <- seq_len(input$nums) -#' if (input$download_option == "ggplot") { -#' ggplot2::ggplot(data.frame(n = numbers), ggplot2::aes(n)) + -#' ggplot2::geom_bar() -#' } else if (input$download_option == "trellis") { -#' lattice::densityplot(numbers) -#' } else if (input$download_option == "grob") { -#' tr_plot <- lattice::densityplot(numbers) -#' ggplot2::ggplotGrob( -#' ggplot2::ggplot(data.frame(n = numbers), ggplot2::aes(n)) + -#' ggplot2::geom_bar() -#' ) -#' } else if (input$download_option == "base") { -#' plot(numbers) -#' } -#' } +#' sliderInput("nums", "Value", 1, 10, 1) +#' ) #' -#' plot_with_settings_srv( -#' id = "plot_with_settings", -#' plot_r = plot_r, -#' height = c(400, 100, 1200), -#' width = c(500, 250, 750) -#' ) +#' server <- function(input, output, session) { +#' plot_r <- function() { +#' numbers <- seq_len(input$nums) +#' if (input$download_option == "ggplot") { +#' ggplot(data.frame(n = numbers), aes(n)) + +#' geom_bar() +#' } else if (input$download_option == "trellis") { +#' densityplot(numbers) +#' } else if (input$download_option == "grob") { +#' tr_plot <- densityplot(numbers) +#' ggplotGrob( +#' ggplot(data.frame(n = numbers), aes(n)) + +#' geom_bar() +#' ) +#' } else if (input$download_option == "base") { +#' plot(numbers) +#' } #' } -#' ) +#' +#' plot_with_settings_srv( +#' id = "plot_with_settings", +#' plot_r = plot_r, +#' height = c(400, 100, 1200), +#' width = c(500, 250, 750) +#' ) +#' } #' #' if (interactive()) { -#' shinyApp(app2$ui, app2$server) +#' shinyApp(ui, server) #' } #' #' # Example with brushing/hovering/clicking/double-clicking -#' app3 <- shinyApp( -#' ui = fluidPage( -#' plot_with_settings_ui( -#' id = "plot_with_settings" -#' ), -#' fluidRow( -#' column(4, h3("Brush"), verbatimTextOutput("brushing_data")), -#' column(4, h3("Click"), verbatimTextOutput("clicking_data")), -#' column(4, h3("DblClick"), verbatimTextOutput("dblclicking_data")), -#' column(4, h3("Hover"), verbatimTextOutput("hovering_data")) -#' ) +#' ui <- fluidPage( +#' plot_with_settings_ui( +#' id = "plot_with_settings" #' ), -#' server = function(input, output, session) { -#' plot_r <- reactive({ -#' ggplot2::ggplot(faithful, ggplot2::aes(x = waiting, y = eruptions)) + -#' ggplot2::geom_point() -#' }) -#' -#' plot_data <- plot_with_settings_srv( -#' id = "plot_with_settings", -#' plot_r = plot_r, -#' height = c(400, 100, 1200), -#' brushing = TRUE, -#' clicking = TRUE, -#' dblclicking = TRUE, -#' hovering = TRUE -#' ) -#' -#' output$brushing_data <- renderPrint(plot_data$brush()) -#' output$clicking_data <- renderPrint(plot_data$click()) -#' output$dblclicking_data <- renderPrint(plot_data$dblclick()) -#' output$hovering_data <- renderPrint(plot_data$hover()) -#' } +#' fluidRow( +#' column(4, h3("Brush"), verbatimTextOutput("brushing_data")), +#' column(4, h3("Click"), verbatimTextOutput("clicking_data")), +#' column(4, h3("DblClick"), verbatimTextOutput("dblclicking_data")), +#' column(4, h3("Hover"), verbatimTextOutput("hovering_data")) +#' ) #' ) #' +#' server <- function(input, output, session) { +#' plot_r <- reactive({ +#' ggplot(faithful, aes(x = waiting, y = eruptions)) + +#' geom_point() +#' }) +#' +#' plot_data <- plot_with_settings_srv( +#' id = "plot_with_settings", +#' plot_r = plot_r, +#' height = c(400, 100, 1200), +#' brushing = TRUE, +#' clicking = TRUE, +#' dblclicking = TRUE, +#' hovering = TRUE +#' ) +#' +#' output$brushing_data <- renderPrint(plot_data$brush()) +#' output$clicking_data <- renderPrint(plot_data$click()) +#' output$dblclicking_data <- renderPrint(plot_data$dblclick()) +#' output$hovering_data <- renderPrint(plot_data$hover()) +#' } +#' #' if (interactive()) { -#' shinyApp(app3$ui, app3$server) +#' shinyApp(ui, server) #' } #' #' # Example which allows module to be hidden/shown #' library("shinyjs") #' -#' app4 <- shinyApp( -#' ui = fluidPage( -#' useShinyjs(), -#' actionButton("button", "Show/Hide"), -#' plot_with_settings_ui( -#' id = "plot_with_settings" -#' ) -#' ), -#' server = function(input, output, session) { -#' plot_r <- plot_r <- reactive( -#' ggplot2::ggplot(faithful, ggplot2::aes(x = waiting, y = eruptions)) + -#' ggplot2::geom_point() -#' ) -#' -#' show_hide_signal_rv <- reactiveVal(TRUE) -#' -#' observeEvent(input$button, show_hide_signal_rv(!show_hide_signal_rv())) -#' -#' plot_with_settings_srv( -#' id = "plot_with_settings", -#' plot_r = plot_r, -#' height = c(400, 100, 1200), -#' width = c(500, 250, 750), -#' show_hide_signal = reactive(show_hide_signal_rv()) -#' ) -#' } +#' ui <- fluidPage( +#' useShinyjs(), +#' actionButton("button", "Show/Hide"), +#' plot_with_settings_ui( +#' id = "plot_with_settings" +#' ) #' ) #' +#' server <- function(input, output, session) { +#' plot_r <- plot_r <- reactive( +#' ggplot(faithful, aes(x = waiting, y = eruptions)) + +#' geom_point() +#' ) +#' +#' show_hide_signal_rv <- reactiveVal(TRUE) +#' +#' observeEvent(input$button, show_hide_signal_rv(!show_hide_signal_rv())) +#' +#' plot_with_settings_srv( +#' id = "plot_with_settings", +#' plot_r = plot_r, +#' height = c(400, 100, 1200), +#' width = c(500, 250, 750), +#' show_hide_signal = reactive(show_hide_signal_rv()) +#' ) +#' } +#' #' if (interactive()) { -#' shinyApp(app4$ui, app4$server) +#' shinyApp(ui, server) #' } #' plot_with_settings_srv <- function(id, diff --git a/R/verbatim_popup.R b/R/verbatim_popup.R index 9566d9e7..18e54a5f 100644 --- a/R/verbatim_popup.R +++ b/R/verbatim_popup.R @@ -13,7 +13,8 @@ #' @export #' #' @examples -#' ui <- shiny::fluidPage(verbatim_popup_ui("my_id", button_label = "Open popup")) +#' library(shiny) +#' ui <- fluidPage(verbatim_popup_ui("my_id", button_label = "Open popup")) #' srv <- function(input, output) { #' verbatim_popup_srv( #' "my_id", @@ -22,7 +23,7 @@ #' style = TRUE #' ) #' } -#' if (interactive()) shiny::shinyApp(ui, srv) +#' if (interactive()) shinyApp(ui, srv) #' verbatim_popup_ui <- function(id, button_label, type = c("button", "link"), ...) { checkmate::assert_string(id) diff --git a/man/draggable_buckets.Rd b/man/draggable_buckets.Rd index 6566f38b..debba645 100644 --- a/man/draggable_buckets.Rd +++ b/man/draggable_buckets.Rd @@ -27,12 +27,12 @@ A custom widget with draggable elements that can be put into buckets. \code{shinyvalidate} validation can be used with this widget. See example below. } \examples{ - -ui <- shiny::fluidPage( +library(shiny) +ui <- fluidPage( draggable_buckets("id", "Choices #1", c("a", "b"), c("bucket1", "bucket2")), draggable_buckets("id2", "Choices #2", letters, c("vowels", "consonants")), - shiny::verbatimTextOutput("out"), - shiny::verbatimTextOutput("out2") + verbatimTextOutput("out"), + verbatimTextOutput("out2") ) server <- function(input, output) { iv <- shinyvalidate::InputValidator$new() @@ -42,28 +42,28 @@ server <- function(input, output) { ) iv$enable() - shiny::observeEvent(list(input$id, input$id2), { + observeEvent(list(input$id, input$id2), { print(isolate(input$id)) print(isolate(input$id2)) }) - output$out <- shiny::renderPrint({ + output$out <- renderPrint({ iv$is_valid() input$id }) - output$out2 <- shiny::renderPrint(input$id2) + output$out2 <- renderPrint(input$id2) } -if (interactive()) shiny::shinyApp(ui, server) +if (interactive()) shinyApp(ui, server) # With default elements in the bucket -ui <- shiny::fluidPage( +ui <- fluidPage( draggable_buckets("id", "Choices #1", c("a", "b"), list(bucket1 = character(), bucket2 = c("c"))), - shiny::verbatimTextOutput("out") + verbatimTextOutput("out") ) server <- function(input, output) { - shiny::observeEvent(input$id, { - print(shiny::isolate(input$id)) + observeEvent(input$id, { + print(isolate(input$id)) }) - output$out <- shiny::renderPrint(input$id) + output$out <- renderPrint(input$id) } -if (interactive()) shiny::shinyApp(ui, server) +if (interactive()) shinyApp(ui, server) } diff --git a/man/get_dt_rows.Rd b/man/get_dt_rows.Rd index aff4dca8..34d1a11f 100644 --- a/man/get_dt_rows.Rd +++ b/man/get_dt_rows.Rd @@ -19,10 +19,12 @@ get_dt_rows(dt_name, dt_rows) } \examples{ library(shiny) +library(DT) + ui <- function(id) { ns <- NS(id) tagList( - DT::DTOutput(ns("data_table")), + DTOutput(ns("data_table")), get_dt_rows(ns("data_table"), ns("dt_rows")) ) } @@ -30,7 +32,7 @@ ui <- function(id) { # use the input$dt_rows in the Shiny Server function server <- function(id) { moduleServer(id, function(input, output, session) { - output$data_table <- DT::renderDataTable( + output$data_table <- renderDataTable( { iris }, diff --git a/man/nested_closeable_modal.Rd b/man/nested_closeable_modal.Rd index e43a5d80..4cd24999 100644 --- a/man/nested_closeable_modal.Rd +++ b/man/nested_closeable_modal.Rd @@ -27,8 +27,10 @@ using \code{jQuery} and modal \code{id}, without disturbing the parent modal. \examples{ # nolint start library(shiny) +library(shinyjs) + ui <- fluidPage( - shinyjs::useShinyjs(), + useShinyjs(), actionButton("show_1", "$('#modal_1').modal('show')"), nested_closeable_modal( "modal_1", @@ -71,20 +73,20 @@ ui <- fluidPage( ) server <- function(input, output) { observeEvent(input$show_1, { - shinyjs::runjs("$('#modal_1').modal('show')") + runjs("$('#modal_1').modal('show')") }) observeEvent(input$show_2, { - shinyjs::runjs("$('#modal_2').modal('show')") + runjs("$('#modal_2').modal('show')") }) observeEvent(c(input$hide_1, input$hide_all), { - shinyjs::runjs("$('#modal_1').modal('hide')") + runjs("$('#modal_1').modal('hide')") }) observeEvent(input$hide_2, { - shinyjs::runjs("$('#modal_2').modal('hide')") + runjs("$('#modal_2').modal('hide')") }) } if (interactive()) { - shiny::shinyApp(ui, server) + shinyApp(ui, server) } # nolint end } diff --git a/man/plot_with_settings.Rd b/man/plot_with_settings.Rd index 8d44ff12..2bdbb2b8 100644 --- a/man/plot_with_settings.Rd +++ b/man/plot_with_settings.Rd @@ -78,147 +78,145 @@ By default the plot is rendered with \verb{72 dpi}. In order to change this, to If an invalid value is set then the default value is used and a warning is outputted to the console. } \examples{ -# Example using a reactive as input to plot_r library(shiny) -app1 <- shinyApp( - ui = fluidPage( - plot_with_settings_ui( - id = "plot_with_settings" - ) - ), - server = function(input, output, session) { - plot_r <- reactive({ - ggplot2::ggplot(faithful, ggplot2::aes(x = waiting, y = eruptions)) + - ggplot2::geom_point() - }) - - plot_with_settings_srv( - id = "plot_with_settings", - plot_r = plot_r, - height = c(400, 100, 1200), - width = c(500, 250, 750) - ) - } +library(ggplot2) + +ui <- fluidPage( + plot_with_settings_ui( + id = "plot_with_settings" + ) ) +server <- function(input, output, session) { + plot_r <- reactive({ + ggplot(faithful, aes(x = waiting, y = eruptions)) + + geom_point() + }) + + plot_with_settings_srv( + id = "plot_with_settings", + plot_r = plot_r, + height = c(400, 100, 1200), + width = c(500, 250, 750) + ) +} + if (interactive()) { - shinyApp(app1$ui, app1$server) + shinyApp(ui, server) } # Example using a function as input to plot_r -app2 <- shinyApp( - ui = fluidPage( - radioButtons("download_option", "Select the Option", list("ggplot", "trellis", "grob", "base")), - plot_with_settings_ui( - id = "plot_with_settings" - ), - sliderInput("nums", "Value", 1, 10, 1) +library(lattice) +ui <- fluidPage( + radioButtons("download_option", "Select the Option", list("ggplot", "trellis", "grob", "base")), + plot_with_settings_ui( + id = "plot_with_settings" ), - server = function(input, output, session) { - plot_r <- function() { - numbers <- seq_len(input$nums) - if (input$download_option == "ggplot") { - ggplot2::ggplot(data.frame(n = numbers), ggplot2::aes(n)) + - ggplot2::geom_bar() - } else if (input$download_option == "trellis") { - lattice::densityplot(numbers) - } else if (input$download_option == "grob") { - tr_plot <- lattice::densityplot(numbers) - ggplot2::ggplotGrob( - ggplot2::ggplot(data.frame(n = numbers), ggplot2::aes(n)) + - ggplot2::geom_bar() - ) - } else if (input$download_option == "base") { - plot(numbers) - } - } + sliderInput("nums", "Value", 1, 10, 1) +) - plot_with_settings_srv( - id = "plot_with_settings", - plot_r = plot_r, - height = c(400, 100, 1200), - width = c(500, 250, 750) - ) +server <- function(input, output, session) { + plot_r <- function() { + numbers <- seq_len(input$nums) + if (input$download_option == "ggplot") { + ggplot(data.frame(n = numbers), aes(n)) + + geom_bar() + } else if (input$download_option == "trellis") { + densityplot(numbers) + } else if (input$download_option == "grob") { + tr_plot <- densityplot(numbers) + ggplotGrob( + ggplot(data.frame(n = numbers), aes(n)) + + geom_bar() + ) + } else if (input$download_option == "base") { + plot(numbers) + } } -) + + plot_with_settings_srv( + id = "plot_with_settings", + plot_r = plot_r, + height = c(400, 100, 1200), + width = c(500, 250, 750) + ) +} if (interactive()) { - shinyApp(app2$ui, app2$server) + shinyApp(ui, server) } # Example with brushing/hovering/clicking/double-clicking -app3 <- shinyApp( - ui = fluidPage( - plot_with_settings_ui( - id = "plot_with_settings" - ), - fluidRow( - column(4, h3("Brush"), verbatimTextOutput("brushing_data")), - column(4, h3("Click"), verbatimTextOutput("clicking_data")), - column(4, h3("DblClick"), verbatimTextOutput("dblclicking_data")), - column(4, h3("Hover"), verbatimTextOutput("hovering_data")) - ) +ui <- fluidPage( + plot_with_settings_ui( + id = "plot_with_settings" ), - server = function(input, output, session) { - plot_r <- reactive({ - ggplot2::ggplot(faithful, ggplot2::aes(x = waiting, y = eruptions)) + - ggplot2::geom_point() - }) - - plot_data <- plot_with_settings_srv( - id = "plot_with_settings", - plot_r = plot_r, - height = c(400, 100, 1200), - brushing = TRUE, - clicking = TRUE, - dblclicking = TRUE, - hovering = TRUE - ) - - output$brushing_data <- renderPrint(plot_data$brush()) - output$clicking_data <- renderPrint(plot_data$click()) - output$dblclicking_data <- renderPrint(plot_data$dblclick()) - output$hovering_data <- renderPrint(plot_data$hover()) - } + fluidRow( + column(4, h3("Brush"), verbatimTextOutput("brushing_data")), + column(4, h3("Click"), verbatimTextOutput("clicking_data")), + column(4, h3("DblClick"), verbatimTextOutput("dblclicking_data")), + column(4, h3("Hover"), verbatimTextOutput("hovering_data")) + ) ) +server <- function(input, output, session) { + plot_r <- reactive({ + ggplot(faithful, aes(x = waiting, y = eruptions)) + + geom_point() + }) + + plot_data <- plot_with_settings_srv( + id = "plot_with_settings", + plot_r = plot_r, + height = c(400, 100, 1200), + brushing = TRUE, + clicking = TRUE, + dblclicking = TRUE, + hovering = TRUE + ) + + output$brushing_data <- renderPrint(plot_data$brush()) + output$clicking_data <- renderPrint(plot_data$click()) + output$dblclicking_data <- renderPrint(plot_data$dblclick()) + output$hovering_data <- renderPrint(plot_data$hover()) +} + if (interactive()) { - shinyApp(app3$ui, app3$server) + shinyApp(ui, server) } # Example which allows module to be hidden/shown library("shinyjs") -app4 <- shinyApp( - ui = fluidPage( - useShinyjs(), - actionButton("button", "Show/Hide"), - plot_with_settings_ui( - id = "plot_with_settings" - ) - ), - server = function(input, output, session) { - plot_r <- plot_r <- reactive( - ggplot2::ggplot(faithful, ggplot2::aes(x = waiting, y = eruptions)) + - ggplot2::geom_point() - ) - - show_hide_signal_rv <- reactiveVal(TRUE) - - observeEvent(input$button, show_hide_signal_rv(!show_hide_signal_rv())) - - plot_with_settings_srv( - id = "plot_with_settings", - plot_r = plot_r, - height = c(400, 100, 1200), - width = c(500, 250, 750), - show_hide_signal = reactive(show_hide_signal_rv()) - ) - } +ui <- fluidPage( + useShinyjs(), + actionButton("button", "Show/Hide"), + plot_with_settings_ui( + id = "plot_with_settings" + ) ) +server <- function(input, output, session) { + plot_r <- plot_r <- reactive( + ggplot(faithful, aes(x = waiting, y = eruptions)) + + geom_point() + ) + + show_hide_signal_rv <- reactiveVal(TRUE) + + observeEvent(input$button, show_hide_signal_rv(!show_hide_signal_rv())) + + plot_with_settings_srv( + id = "plot_with_settings", + plot_r = plot_r, + height = c(400, 100, 1200), + width = c(500, 250, 750), + show_hide_signal = reactive(show_hide_signal_rv()) + ) +} + if (interactive()) { - shinyApp(app4$ui, app4$server) + shinyApp(ui, server) } } diff --git a/man/verbatim_popup.Rd b/man/verbatim_popup.Rd index 7dbb8af0..dbe7271d 100644 --- a/man/verbatim_popup.Rd +++ b/man/verbatim_popup.Rd @@ -45,7 +45,8 @@ This module consists of a button that once clicked pops up a modal window with verbatim-styled text. } \examples{ -ui <- shiny::fluidPage(verbatim_popup_ui("my_id", button_label = "Open popup")) +library(shiny) +ui <- fluidPage(verbatim_popup_ui("my_id", button_label = "Open popup")) srv <- function(input, output) { verbatim_popup_srv( "my_id", @@ -54,6 +55,6 @@ srv <- function(input, output) { style = TRUE ) } -if (interactive()) shiny::shinyApp(ui, srv) +if (interactive()) shinyApp(ui, srv) } From a76a55059ae2faf4c67e4eb24aff470d6ca724e6 Mon Sep 17 00:00:00 2001 From: unknown Date: Tue, 30 Jan 2024 18:44:37 +0530 Subject: [PATCH 8/9] fixing Rd --- man/plot_with_settings.Rd | 1 + 1 file changed, 1 insertion(+) diff --git a/man/plot_with_settings.Rd b/man/plot_with_settings.Rd index 2bdbb2b8..c38cadc6 100644 --- a/man/plot_with_settings.Rd +++ b/man/plot_with_settings.Rd @@ -78,6 +78,7 @@ By default the plot is rendered with \verb{72 dpi}. In order to change this, to If an invalid value is set then the default value is used and a warning is outputted to the console. } \examples{ +# Example using a reactive as input to plot_r library(shiny) library(ggplot2) From 525bd7819c912dd1b5e5aa1ba2b5d340dd941bd5 Mon Sep 17 00:00:00 2001 From: unknown Date: Tue, 30 Jan 2024 18:47:10 +0530 Subject: [PATCH 9/9] compacting example. --- R/optionalInput.R | 24 ++++++------------------ man/optionalSelectInput.Rd | 24 ++++++------------------ 2 files changed, 12 insertions(+), 36 deletions(-) diff --git a/R/optionalInput.R b/R/optionalInput.R index 4bf23474..c9305ff5 100644 --- a/R/optionalInput.R +++ b/R/optionalInput.R @@ -123,24 +123,12 @@ #' ) #' }) #' -#' output$c1_out <- renderPrint({ -#' input$c1 -#' }) -#' output$c2_out <- renderPrint({ -#' input$c2 -#' }) -#' output$c3_out <- renderPrint({ -#' input$c3 -#' }) -#' output$c4_out <- renderPrint({ -#' input$c4 -#' }) -#' output$c5_out <- renderPrint({ -#' input$c5 -#' }) -#' output$c6_out <- renderPrint({ -#' input$c6 -#' }) +#' output$c1_out <- renderPrint(input$c1) +#' output$c2_out <- renderPrint(input$c2) +#' output$c3_out <- renderPrint(input$c3) +#' output$c4_out <- renderPrint(input$c4) +#' output$c5_out <- renderPrint(input$c5) +#' output$c6_out <- renderPrint(input$c6) #' } #' #' if (interactive()) { diff --git a/man/optionalSelectInput.Rd b/man/optionalSelectInput.Rd index 27049b43..a9939a75 100644 --- a/man/optionalSelectInput.Rd +++ b/man/optionalSelectInput.Rd @@ -167,24 +167,12 @@ server <- function(input, output, session) { ) }) - output$c1_out <- renderPrint({ - input$c1 - }) - output$c2_out <- renderPrint({ - input$c2 - }) - output$c3_out <- renderPrint({ - input$c3 - }) - output$c4_out <- renderPrint({ - input$c4 - }) - output$c5_out <- renderPrint({ - input$c5 - }) - output$c6_out <- renderPrint({ - input$c6 - }) + output$c1_out <- renderPrint(input$c1) + output$c2_out <- renderPrint(input$c2) + output$c3_out <- renderPrint(input$c3) + output$c4_out <- renderPrint(input$c4) + output$c5_out <- renderPrint(input$c5) + output$c6_out <- renderPrint(input$c6) } if (interactive()) {