Skip to content

Commit

Permalink
Fix bookmarking of updated input
Browse files Browse the repository at this point in the history
  • Loading branch information
nfrerebeau committed Dec 22, 2024
1 parent 03f3eef commit 5c51a3b
Show file tree
Hide file tree
Showing 3 changed files with 24 additions and 18 deletions.
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,7 @@ vignettes/figures/
*.utf8.md
*.knit.md
# Shiny token, see https://shiny.rstudio.com/articles/shinyapps.html
shiny_bookmarks/
rsconnect/
.Rproj.user
inst/doc
Expand Down
8 changes: 5 additions & 3 deletions R/plot.R
Original file line number Diff line number Diff line change
Expand Up @@ -62,13 +62,15 @@ render_plot <- function(id, x, ...) {
stopifnot(is.reactive(x))

moduleServer(id, function(input, output, session) {
## Plot
output$plot <- renderPlot(x()(), ...)

## Show modal dialog
observe({ showModal(download_plot(session$ns)) }) |>
bindEvent(input$download)

setBookmarkExclude(c("download", "width", "height"))

## Plot
output$plot <- renderPlot(x()(), ...)

## Preview
output$preview <- renderImage({
req(x())
Expand Down
33 changes: 18 additions & 15 deletions R/prepare.R
Original file line number Diff line number Diff line change
Expand Up @@ -149,6 +149,7 @@ select_ui <- function(id) {
label = "Select columns:",
choices = NULL,
selected = NULL,
inline = TRUE,
width = "100%"
),
checkboxInput(
Expand All @@ -167,19 +168,28 @@ select_server <- function(id, x) {
updateCheckboxGroupInput(
inputId = "select",
choices = colnames(x()),
selected = colnames(x()),
inline = TRUE
selected = colnames(x())
)
}) |>
bindEvent(x())

onBookmark(function(state) {
state$values$selected <- input$select
})
onRestored(function(state) {
selected <- state$values$selected
updateCheckboxGroupInput(session, "select", selected = selected)
})

## Select columns
reactive({
req(x())
x <- arkhe::get_columns(x(), names = input$select)

if (isTRUE(input$rownames)) {
y <- run_with_notification(arkhe::assign_rownames(x, column = 1, remove = TRUE))
y <- run_with_notification(
arkhe::assign_rownames(x, column = 1, remove = TRUE)
)
if (!is.null(y)) x <- y
}

Expand Down Expand Up @@ -330,34 +340,27 @@ filter_server <- function(id, x) {
stopifnot(is.reactive(x))

moduleServer(id, function(input, output, session) {
## Get variable names
vars <- reactive({ names(x()) })

## Build UI
output$controls <- renderUI({
lapply(
X = vars(),
FUN = function(var) {
filter_build(x()[[var]], session$ns(var), var)
}
FUN = function(var) filter_build(x()[[var]], session$ns(var), var)
)
})

# /!\ Disable suspend for output$controls /!\
outputOptions(output, "controls", suspendWhenHidden = FALSE)

filter <- reactive({
each_var <- lapply(
X = vars(),
FUN = function(var, input) {
filter_var(x()[[var]], input[[var]])
},
FUN = function(var, input) filter_var(x()[[var]], input[[var]]),
input = input
)
Reduce(f = `&`, x = each_var)
})

reactive({
x()[filter(), , drop = FALSE]
})
reactive({ x()[filter(), , drop = FALSE] })
})
}
filter_var <- function(x, val) {
Expand Down

0 comments on commit 5c51a3b

Please sign in to comment.