Skip to content

Commit

Permalink
Add second example showing shiny.destroy capabilities (#12)
Browse files Browse the repository at this point in the history
* Add sleep example of shiny.destroy v shiny

* Make a better comparison of shiny v shiny.destroy

* Fix fill in example app

* Make app truly comparable
  • Loading branch information
ashbaldry authored Sep 9, 2024
1 parent deccb16 commit 653b2e7
Showing 1 changed file with 112 additions and 0 deletions.
112 changes: 112 additions & 0 deletions inst/examples-shiny/02_sleep/app.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,112 @@
library(bslib)
library(shiny)
library(shiny.destroy)

boxModuleUI <- function(id) {
ns <- NS(id)

bslib::card(
id = ns("card"),
h3("Box for", sub("_", " ", id)),
actionButton(ns("destroy"), "Remove card")
)
}

boxModuleServer <- function(id, create_card, destroyable = FALSE) {
moduleServer(id, function(input, output, session) {
observeEvent(create_card(), Sys.sleep(1L))
observeEvent(input$destroy, {
if (destroyable) {
destroyModule()
} else {
removeUI(paste0("#", session$ns("card")))
}
})
})
}

destroyableBoxModuleUI <- makeModuleUIDestroyable(boxModuleUI)
destroyableBoxModuleServer <- makeModuleServerDestroyable(boxModuleServer)

comparisonModuleUI <- function(id, title) {
ns <- NS(id)

tagList(
h2(title),
bslib::layout_columns(
div(
p("Number of boxes:", textOutput(ns("n_modules"), inline = TRUE)),
p("Time taken to create last box:", textOutput(ns("time_elapsed"), inline = TRUE)),
actionButton(ns("create"), "Create new module")
),
div(
h3("Inputs"),
verbatimTextOutput(ns("inputs"))
),
col_widths = c(3, 9)
),
div(id = ns("cards"))
)
}

comparisonModuleServer <- function(id, destroyable = FALSE) {
module_server_fn <- if (destroyable) destroyableBoxModuleServer else boxModuleServer
module_ui_fn <- if (destroyable) destroyableBoxModuleUI else boxModuleUI

moduleServer(id, function(input, output, session) {
card_id <- reactiveVal(1L)
ns <- session$ns

observeEvent(input$create, {
ns_id <- paste0("card_", card_id())
cards_id <- ns("cards")
insertUI(paste0("#", cards_id), "beforeEnd", module_ui_fn(id = ns(ns_id)))
module_server_fn(id = ns_id, create_card = reactive(input$create), destroyable = destroyable)

card_id(card_id() + 1L)
})

output$n_modules <- renderText({
sum(grepl(ns("destroy"), names(input)))
})

output$inputs <- renderPrint({
inputs <- vapply(names(input), \(x) paste0(x, ": ", input[[x]]), character(1L))
cat(inputs, sep = "\n")
})

time_init <- reactiveVal(NULL)
time_end <- reactiveVal(NULL)

observeEvent(input$create, priority = 1L, time_init(Sys.time()))
observeEvent(input$create, priority = -1L, time_end(Sys.time()))

output$time_elapsed <- renderText(paste0(round(time_end() - time_init()), "s")) |>
bindEvent(time_end())
})
}

ui <- bslib::page_fluid(
title = "shiny.destroy comparison",
h1("shiny v shiny.destroy comparison"),
p(
"For each box module created, a second will elapse. As more boxes are created, the longer",
"it will take for the app to become responsive again."
),
p(
"Click the new modules and see the time comparison it takes to create a new destroyable",
"module after some boxes have been deleted compared to using standard shiny calls"
),
bslib::layout_columns(
comparisonModuleUI("shiny", "Shiny modules"),
comparisonModuleUI("shiny_destroy", "Destroyable modules"),
fillable = FALSE
)
)

server <- function(input, output, session) {
comparisonModuleServer("shiny")
comparisonModuleServer("shiny_destroy", destroyable = TRUE)
}

shinyApp(ui, server)

0 comments on commit 653b2e7

Please sign in to comment.